Permalink
Browse files

Add a crude IO::Socket(::INET) port to JVM, add to build

  • Loading branch information...
tadzik authored and donaldh committed Aug 16, 2013
1 parent b03eced commit f18135490ce1b9dbc4a4ad98ade9d8117c239313
Showing with 187 additions and 2 deletions.
  1. +68 −0 src/vm/jvm/core/IO/Socket.pm
  2. +117 −0 src/vm/jvm/core/IO/Socket/INET.pm
  3. +2 −2 tools/build/Makefile-JVM.in
@@ -0,0 +1,68 @@
+my role IO::Socket does IO {
+ has Mu $!sock;
+ has $!buffer = '';
+
+ # if bin is true, will return Buf, Str otherwise
+ method recv (Cool $chars = $Inf, :$bin? = False) {
+ fail('Socket not available') unless $!sock;
+
+ if $!buffer.chars < $chars {
+ my $bytes = nqp::read($!sock, nqp::decont(blob8.new), 512);
+ my $s = $bytes;
+ unless $bin {
+ $s = $bytes.decode('utf-8');
+ }
+ $!buffer ~= nqp::p6box_s($s);
+ }
+
+ my $rec;
+ if $!buffer.chars > $chars {
+ $rec = $!buffer.substr(0, $chars);
+ $!buffer = $!buffer.substr($chars);
+ } else {
+ $rec = $!buffer;
+ $!buffer = '';
+ }
+
+ if $bin {
+ nqp::encode(nqp::unbox_s($rec), 'binary', buf8.new);
+ }
+ else {
+ $rec
+ }
+ }
+
+ method read(IO::Socket:D: Cool $bufsize as Int) {
+ fail('Socket not available') unless $!sock;
+ my str $res;
+ my str $read;
+ repeat {
+ my $bytes = nqp::read($!sock, nqp::decont(blob8.new), $bufsize - nqp::chars($res));
+ $read = nqp::encode(nqp::unbox_s($bytes), 'binary', buf8.new);
+ $res = nqp::concat($res, $read);
+ } while nqp::chars($res) < $bufsize && nqp::chars($read);
+ nqp::encode(nqp::unbox_s($res), 'binary', buf8.new);
+ }
+
+ method poll(Int $bitmask, $seconds) {
+ return True; # FIXME
+ }
+
+ method send (Cool $string as Str) {
+ fail("Not connected") unless $!sock;
+ nqp::write($!sock, nqp::decont(nqp::unbox_s($string).encode('utf-8')));
+ return True; # FIXME
+ }
+
+ method write(Blob:D $buf) {
+ fail('Socket not available') unless $!sock;
+ nqp::write($!sock, nqp::decont($buf));
+ return True; # FIXME
+ }
+
+ method close () {
+ fail("Not connected!") unless $!sock;
+ nqp::closefh($!sock);
+ return True; # FIXME
+ }
+}
@@ -0,0 +1,117 @@
+my class IO::Socket::INET does IO::Socket {
+ my module PIO {
+ constant PF_LOCAL = 0;
+ constant PF_UNIX = 1;
+ constant PF_INET = 2;
+ constant PF_INET6 = 3;
+ constant PF_MAX = 4;
+ constant SOCK_PACKET = 0;
+ constant SOCK_STREAM = 1;
+ constant SOCK_DGRAM = 2;
+ constant SOCK_RAW = 3;
+ constant SOCK_RDM = 4;
+ constant SOCK_SEQPACKET = 5;
+ constant SOCK_MAX = 6;
+ constant PROTO_TCP = 6;
+ constant PROTO_UDP = 17;
+ }
+
+ has Str $.encoding = 'utf8';
+ has Str $.host;
+ has Int $.port = 80;
+ has Str $.localhost;
+ has Int $.localport;
+ has Bool $.listen;
+ has $.family = PIO::PF_INET;
+ has $.proto = PIO::PROTO_TCP;
+ has $.type = PIO::SOCK_STREAM;
+ has Str $.input-line-separator is rw = "\n";
+ has Int $.ins = 0;
+
+ my sub v4-split($uri) {
+ return $uri.split(':', 2);
+ }
+
+ my sub v6-split($uri) {
+ my ($host, $port) = ($uri ~~ /^'[' (.+) ']' \: (\d+)$/)[0,1];
+ return $host ?? ($host, $port) !! $uri;
+ }
+
+ method new (*%args is copy) {
+ fail "Nothing given for new socket to connect or bind to" unless %args<host> || %args<listen>;
+
+ if %args<host> {
+ my ($host, $port) = %args<family> && %args<family> == PIO::PF_INET6()
+ ?? v6-split(%args<host>)
+ !! v4-split(%args<host>);
+ if $port {
+ %args<port> //= $port;
+ %args<host> = $host;
+ }
+ }
+ if %args<localhost> {
+ my ($peer, $port) = %args<family> && %args<family> == PIO::PF_INET6()
+ ?? v6-split(%args<localhost>)
+ !! v4-split(%args<localhost>);
+ if $port {
+ %args<localport> //= $port;
+ %args<localhost> = $peer;
+ }
+ }
+
+ %args<listen>.=Bool if %args.exists('listen');
+
+ #TODO: Learn what protocols map to which socket types and then determine which is needed.
+ self.bless(*, |%args)!initialize()
+ }
+
+ method !initialize() {
+ my $sock := nqp::socket();
+
+ #Quoting perl5's SIO::INET:
+ #If Listen is defined then a listen socket is created, else if the socket type,
+ #which is derived from the protocol, is SOCK_STREAM then connect() is called.
+ if $.listen || $.localhost || $.localport {
+ nqp::bindsock($sock, nqp::unbox_s($.localhost || "0.0.0.0"),
+ nqp::unbox_i($.localport || 0));
+ }
+
+ if $.listen {
+ nqp::listen($sock);
+ }
+ elsif $.type == PIO::SOCK_STREAM {
+ my $addr := nqp::connect($sock, nqp::unbox_s($.host), nqp::unbox_i($.port));
+ }
+
+ nqp::bindattr(self, $?CLASS, '$!sock', $sock);
+ self;
+ }
+
+ method get() {
+ ...
+ }
+
+ method lines() {
+ gather while (my $line = self.get()).defined {
+ take $line;
+ }
+ }
+
+ method accept() {
+ #my $new_sock := nqp::create($?CLASS);
+ ## A solution as proposed by moritz
+ my $new_sock := $?CLASS.bless(*, :$!family, :$!proto, :$!type, :$!input-line-separator);
+ nqp::getattr($new_sock, $?CLASS, '$!buffer') = '';
+ nqp::bindattr($new_sock, $?CLASS, '$!sock',
+ nqp::accept(nqp::getattr(self, $?CLASS, '$!sock')));
+ return $new_sock;
+ }
+
+ method remote_address() {
+ ...
+ }
+
+ method local_address() {
+ ...
+ }
+}
@@ -174,8 +174,6 @@ CORE_SOURCES = \
src/core/IO/Spec.pm \
src/core/IO.pm \
src/core/IO/ArgFiles.pm \
- src/core/IO/Socket.pm \
- src/core/IO/Socket/INET.pm \
src/core/AST.pm \
src/core/CallFrame.pm \
src/core/Main.pm \
@@ -197,6 +195,8 @@ CORE_SOURCES = \
src/core/precedence.pm \
src/core/terms.pm \
src/vm/jvm/core/Threading.pm \
+ src/vm/jvm/core/IO/Socket.pm \
+ src/vm/jvm/core/IO/Socket/INET.pm \
src/core/core_epilogue.pm \
CLEANUPS = \

0 comments on commit f181354

Please sign in to comment.