Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

a few fixes to writer.pl to make fwds actually work, and some utility…

… scripts to dial, listen, and send signals... a huge refactor is greatly needed soon
  • Loading branch information...
commit baa8284e976704beff3cfe60118ed4e869b7f4ce 1 parent 1a92d0f
@quartzjer authored
View
1  LICENSE
@@ -0,0 +1 @@
+This work is in the Public Domain. To view a copy of the public domain certification, visit http://creativecommons.org/licenses/publicdomain/ or send a letter to Creative Commons, 171 Second Street, Suite 300, San Francisco, California, 94105, USA.
View
117 perl/dial.pl
@@ -0,0 +1,117 @@
+#!/usr/bin/perl
+
+# given a hash (or otherwise), find the closest writers
+
+use Digest::SHA1 qw(sha1_hex);
+use IO::Select;
+use Socket;
+use JSON::DWIW;
+my $json = JSON::DWIW->new;
+
+my $hash = (length($ARGV[0])==40)?$ARGV[0]:sha1_hex($ARGV[0]);
+printf "Dialing %s\n",$hash;
+
+# defaults to listen on any ip and random port
+my $port = 0;
+my $ip = "0.0.0.0";
+my $seed = $ARGV[1]||"telehash.org:42424";
+
+$iaddr = gethostbyname($ip);
+$proto = getprotobyname('udp');
+$paddr = sockaddr_in($port, $iaddr);
+socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) or die "socket: $!";
+bind(SOCKET, $paddr) or die "bind: $!";
+$sel = IO::Select->new();
+$sel->add(\*SOCKET);
+
+# resolve our seed to it's ip:port
+my($seedhost,$seedport) = split(":",$seed);
+my $seedip = gethostbyname($seedhost);
+my $seedipp = sprintf("%s:%d",inet_ntoa($seedip),$seedport);
+
+# send a hello to the seed
+my $jo = telex($seedipp);
+$jo->{".end"} = $hash;
+tsend($jo);
+
+my %cache; # just a dumb cache of writer hashes
+require "./bixor.pl"; # temp testing hack
+my $buff;
+$|++;
+my $ipp, $ipphash;
+my %resend; # sometimes need to re-send due to nat hole punching
+while(1)
+{
+ # wait for event or timeout loop
+ if(scalar $sel->can_read(5) == 0)
+ {
+ my $bto = bix_new($hash);
+ my @ckeys = sort {bix_sbit(bix_or($bto,bix_new($a))) <=> bix_sbit(bix_or($bto,bix_new($b)))} keys %cache; # sort by closest to the hash
+ print join("\n", map {$cache{$_}."\t".bix_sbit(bix_or($bto,bix_new($_)))} splice @ckeys, 0, 5),"\n";
+ exit;
+ }
+
+ # must be a telex waiting for us
+ my $caddr = recv(SOCKET, $buff, 8192, 0) || die("recv $!");
+ # TODO need some source rate detection in case there's a loop
+
+ # figure out who sent it
+ ($cport, $addr) = sockaddr_in($caddr);
+ my $writer = sprintf("%s:%d",inet_ntoa($addr),$cport);
+ printf "RECV[%s]\t%s\n",$writer,$buff;
+
+ # json parse check
+ my $j = $json->from_json($buff) || next;
+
+ # we've been told to talk to these writers
+ if($j->{".see"})
+ {
+ # loop through and establish lines to them (just being dumb for now and trying everyone)
+ for my $seeipp (@{$j->{".see"}})
+ {
+ next if($seeipp eq $ipp); # skip ourselves :)
+ next if($cache{sha1_hex($seeipp)}); # skip if we know them already
+ $cache{sha1_hex($seeipp)} = $seeipp;
+
+ my $jo = telex($seeipp); # send direct (should open our outgoing to them)
+ $jo->{".end"} = $hash;
+ tsend($jo);
+
+ # send nat request back to the writer who .see'd us in case the new one is behind a nat
+ my $jo = telex($writer);
+ $jo->{".natr"} = $seeipp;
+ $jo->{".pin"} = int($j->{"_line"}); # need to validate our request to them to natr for us
+ tsend($jo);
+ }
+ }else{ # incoming telex with no .see? prolly nat hole punch, dial them again regardless
+ if(!$resend{$writer})
+ {
+ $resend{$writer}++;
+ my $jo = telex($writer);
+ $jo->{".end"} = $hash;
+ tsend($jo);
+ }
+ }
+
+}
+
+# create a new telex
+sub telex
+{
+ my $to = shift;
+ my $js = shift || {};
+ $js->{"_to"} = $to;
+ return $js;
+}
+
+# actually send a telex to it's writer
+sub tsend
+{
+ my $j = shift;
+ my($ip,$port) = split(":",$j->{"_to"});
+ my $wip = gethostbyname($ip);
+ my $waddr = sockaddr_in($port,$wip);
+ my $js = $json->to_json($j);
+ printf "SEND[%s]\t%s\n",$j->{"_to"},$js;
+ defined(send(SOCKET, $js, 0, $waddr)) or die "send $to: $!";
+}
View
103 perl/listen.pl
@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+
+# given a writer ip:port, end hash, signal name and value, just send it
+
+# TODO: doesn't support writers behind a nat yet
+
+use IO::Select;
+use Socket;
+use JSON::DWIW;
+my $json = JSON::DWIW->new;
+
+my $ipp = $ARGV[0];
+my $end = $ARGV[1];
+my $sig = $ARGV[2];
+my $cnt = $ARGV[3] || die("./listen.pl ip:port hashcode signal count");
+
+# defaults to listen on any ip and random port
+my $port = 0;
+my $ip = "0.0.0.0";
+
+$iaddr = gethostbyname($ip);
+$proto = getprotobyname('udp');
+$paddr = sockaddr_in($port, $iaddr);
+socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) or die "socket: $!";
+bind(SOCKET, $paddr) or die "bind: $!";
+$sel = IO::Select->new();
+$sel->add(\*SOCKET);
+
+my $lineout = int(rand(65535));
+my $linein;
+
+# send initial hello to open line
+my $jo = telex($ipp);
+$jo->{".end"}=$end;
+tsend($jo);
+
+
+while(1)
+{
+ # wait for event or timeout loop
+ if(scalar $sel->can_read(300) == 0)
+ {
+ tsend(telex($ipp)); # send keepalive
+ next;
+ }
+
+ # must be a telex waiting for us
+ my $caddr = recv(SOCKET, $buff, 8192, 0) || die("recv $!");
+ # TODO need some source rate detection in case there's a loop
+
+ # figure out who sent it
+ ($cport, $addr) = sockaddr_in($caddr);
+ my $writer = sprintf("%s:%d",inet_ntoa($addr),$cport);
+ printf "RECV[%s]\t%s\n",$writer,$buff;
+ if($writer ne $ipp)
+ {
+ printf "NOTHANKS\n";
+ next;
+ }
+
+ # json parse check
+ my $j = $json->from_json($buff) || next;
+
+ if(!$j->{"_line"})
+ {
+ printf "LINEMISSING\n";
+ next;
+ }
+
+ # first time they respond at all, send them the fwd request now that we have a _line to validate it
+ if(!$linein)
+ {
+ $linein = $j->{"_line"};
+ my $jo = telex($ipp);
+ $jo->{".fwd"} = {$sig=>$cnt};
+ $jo->{".end"} = $end;
+ $jo->{".pin"} = $linein;
+ tsend($jo);
+ }
+
+}
+
+# create a new telex
+sub telex
+{
+ my $to = shift;
+ my $js = shift || {};
+ $js->{"_to"} = $to;
+ $js->{"_line"} = $lineout;
+ return $js;
+}
+
+# actually send a telex to it's writer
+sub tsend
+{
+ my $j = shift;
+ my($ip,$port) = split(":",$j->{"_to"});
+ my $wip = gethostbyname($ip);
+ my $waddr = sockaddr_in($port,$wip);
+ my $js = $json->to_json($j);
+ printf "SEND[%s]\t%s\n",$j->{"_to"},$js;
+ defined(send(SOCKET, $js, 0, $waddr)) or die "send $to: $!";
+}
View
34 perl/signal.pl
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+# given a writer ip:port, end hash, signal name and value, just send it
+
+use IO::Select;
+use Socket;
+use JSON::DWIW;
+my $json = JSON::DWIW->new;
+
+my $ipp = $ARGV[0];
+my $end = $ARGV[1];
+my $sig = $ARGV[2];
+my $val = $ARGV[3] || die("./signal.pl ip:port hashcode signame sigvalue");
+
+# defaults to listen on any ip and random port
+my $port = 0;
+my $ip = "0.0.0.0";
+
+$iaddr = gethostbyname($ip);
+$proto = getprotobyname('udp');
+$paddr = sockaddr_in($port, $iaddr);
+socket(SOCKET, PF_INET, SOCK_DGRAM, $proto) or die "socket: $!";
+bind(SOCKET, $paddr) or die "bind: $!";
+$sel = IO::Select->new();
+$sel->add(\*SOCKET);
+
+my $j = {"_to"=>$ipp, ".end"=>$end, $sig=>$val};
+my($ip,$port) = split(":",$ipp);
+my $wip = gethostbyname($ip);
+my $waddr = sockaddr_in($port,$wip);
+my $js = $json->to_json($j);
+printf "SEND[%s]\t%s\n",$j->{"_to"},$js;
+defined(send(SOCKET, $js, 0, $waddr)) or die "send $to: $!";
+
View
51 perl/writer.pl
@@ -1,4 +1,9 @@
#!/usr/bin/perl
+
+# a prototype telehash writer
+
+# Jer 1/2010
+
use Digest::SHA1 qw(sha1_hex);
use IO::Select;
use Socket;
@@ -67,7 +72,7 @@
$lines{$writer}->{"last"} = time();
# check to see if the line matches, and skip if not
- if($lines{$writer}->{"_line"} && $lines{$writer}->{"_line"} ne $j->{"_line"})
+ if($lines{$writer}->{"_line"} && $lines{$writer}->{"_line"} != $j->{"_line"})
{
print "LINE MISMATCH!\n";
next;
@@ -80,6 +85,7 @@
# discover our own ip:port
if(!$ipp && $j->{"_to"})
{
+ printf "SELF[%s]\n",$j->{"_to"};
$ipp = $j->{"_to"};
$ipphash = sha1_hex($ipp);
$cache{$ipphash}=$ipp; # for .end processing, to know ourselves
@@ -94,13 +100,14 @@
# is this .end closest to US? If so, handle it
if($ckeys[0] eq $ipphash)
{
- doend($j,$writer);
+ printf("handling!\n");
}else{ # otherwise send them back a .see of ones closer
my @cipps = map {$cache{$_}} splice @ckeys, 0, 5; # just take top 5 closest
my $jo = telex($writer);
$jo->{".see"} = \@cipps;
tsend($jo);
}
+ doend($j,$writer); # could always be registered forwards
}
# a request to send a .nat to a writer that we should know (and only from writers we have a line to)
@@ -108,11 +115,12 @@
{
my $jo = telex($j->{".natr"});
$jo->{".nat"} = $writer;
+ $jo->{".pin"} = int($lines{$jo->{"_to"}}); # validate ourselves to them
tsend($jo);
}
# we're asked to send something to this ip:port to open a nat
- if($j->{".nat"})
+ if($j->{".nat"} && $j->{".pin"} eq $lines{$writer}->{"id"})
{
tsend(telex($j->{".nat"}));
}
@@ -135,7 +143,7 @@
}
# handle a fwd command, must be verified
- if($j->{".fwd"} && $j->{".pin"} eq $lines{$writer}->{"id"})
+ if($j->{".fwd"} && $j->{".pin"} == $lines{$writer}->{"id"})
{
my $e = getend($j->{".end"});
$e->{"fwds"}->{$writer} = $j->{".fwd"};
@@ -146,7 +154,7 @@
# we do this at the end since the code needs to be refactored, and the $lines entry would only exist by now
# track the incoming line for this writer
- $lines{$writer}->{"_line"} = $j->{"_line"} if($lines{$writer});
+ $lines{$writer}->{"_line"} = int($j->{"_line"}) if($lines{$writer});
}
# create a new telex
@@ -160,7 +168,7 @@ sub telex
$lines{$to} = { "id" => int(rand(65535)), "first" => time(), "last" => time() };
}
$js->{"_to"} = $to;
- $js->{"_line"} = $lines{$to}->{"id"};
+ $js->{"_line"} = int($lines{$to}->{"id"});
return $js;
}
@@ -204,10 +212,37 @@ sub doend
my $e = getend($t->{".end"});
$e->{$writer} = $t; # store only one telex per writer per end
# check for any registered fwds
- for my $fw (keys %{$e->{"fwds"}})
+ for my $wf (keys %{$e->{"fwds"}})
{
+ printf "checking fwd %s\n",$wf;
+ # make sure we still have a line open to this writer, if not cancel this forward
+ if(!$lines{$wf}) # todo for later refactor, this should be cleaned up when the line is purged not here
+ {
+ delete $e->{"fwds"}->{$wf};
+ next;
+ }
+ # get the actual .fwd request for this writer
+ my $fwds = $e->{"fwds"}->{$wf};
# check if any of the signals match, if so forward this telex
- # TODO
+ my @sigs = grep($t->{$_},keys %$fwds);
+ next unless(scalar @sigs > 0);
+ map {$fwds->{$_}--} keys %$fwds; # decrement counters
+ for my $sig (keys %$fwds) # zap any that are gone
+ {
+ delete $fwds->{$sig} unless($fwds->{$sig} > 0);
+ }
+ delete $e->{"fwds"}->{$wf} unless(scalar keys %$fwds > 0); # no more fwds, zap
+
+ my $jo = telex($wf);
+ # copy all signals
+ for my $sig (grep(/^[[:alnum:]]+/, keys %$t))
+ {
+ $jo->{$sig} = $t->{$sig};
+ }
+ # copy timestamp if any
+ $jo->{"_at"} = $t->{"_at"} if($t->{"_at"});
+ $jo->{"fwds"} = $fwds; # tell them current status
+ tsend($jo);
}
}
Please sign in to comment.
Something went wrong with that request. Please try again.