changeset 1:e23d55b94840

Modify Server
author e165727 <e165727@ie.u-ryukyu.ac.jp>
date Wed, 05 Feb 2020 23:45:09 +0900
parents 11ef16a351e6
children f3eb367c309f
files .DS_Store lib/.DS_Store lib/Abyss/Server.pm6 lib/Abyss/Unix.pm6
diffstat 4 files changed, 204 insertions(+), 21 deletions(-) [+]
line wrap: on
line diff
Binary file .DS_Store has changed
Binary file lib/.DS_Store has changed
--- a/lib/Abyss/Server.pm6	Fri Jan 17 12:11:01 2020 +0900
+++ b/lib/Abyss/Server.pm6	Wed Feb 05 23:45:09 2020 +0900
@@ -1,29 +1,50 @@
 use v6.c;
 unit class Abyss::Server:ver<0.0.1>:auth<cpan:ANATOFUZ>;
+use MONKEY-SEE-NO-EVAL;
+use IO::Socket::Unix;
+use NativeCall;
 
-use MONKEY-SEE-NO-EVAL;
+sub close(int32) returns int32 is native { ... }
+sub dup(int32 $old) returns int32 is native { ... }
+sub dup2(int32 $old, int32 $new) returns int32 is native { ... }
 
-method readeval {
-  my $listen = IO::Socket::INET.new( :listen,
-                                     :localhost<localhost>,
-                                     :localport(3333) );
-  my $counter = 0;
-  my $now = DateTime.now(formatter => { sprintf "%03d:%03d:%03d", .hour, .minute ,.second});
-  loop {
-      my $conn = $listen.accept;
-          while my $buf = $conn.read(1024) {
-              EVALFILE $buf.decode;
-              $counter++;
-          }
-      $conn.close;
+method readeval 
+{
+    my $listen = IO::Socket::Unix.new(  :listen,
+                                        :localhost<localhost>,
+                                        :localport(3333) );
+                                     
+    my $backup = dup(1);#stdoutのバックアップを作成
+    say DateTime.now;
+    my $sumTime = 0;
+    my $counter = 0;
+  
+    loop 
+    {
+        my $conn = $listen.accept;
+        dup2($conn.native-descriptor(), 1);#stdoutをsocketに切り替え
+        my $start = now;
+        say "hoge";
+        while my $buf = $conn.read(1024) 
+        {
+            EVALFILE $buf.decode;
+            $counter++;
+        }
+        my $end = now;
+        my $Time = $end - $start;
+        $sumTime = $sumTime + $Time;
+        say $Time; 
+        dup2($backup, 1); #file descripterを元に戻す
+        close($backup); #backup消す
+      
+        $conn.close;
 
-      if ($counter == 100) {
-       last;
-      }
-  }
-  $now = DateTime.now(formatter => { sprintf "%03d:%03d:%03d", .hour, .minute ,.second});
-  say $now;
-
+        if ($counter == 10) 
+        {
+            say $sumTime;
+            last;
+        }
+    } 
 }
 
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Abyss/Unix.pm6	Wed Feb 05 23:45:09 2020 +0900
@@ -0,0 +1,162 @@
+my class Abyss::Unix does IO::Socket {
+    
+    use nqp;
+
+    my module PIO {
+        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;
+        constant MIN_PORT       = 0;
+        constant MAX_PORT       = 65_535; # RFC 793: TCP/UDP port limit
+    }
+
+    has Str  $.host;
+    has Int  $.port;
+    has Str  $.localhost;
+    has Int  $.localport;
+    has Int  $.backlog;
+    has Bool $.listening;
+    has      $.family     = nqp::const::SOCKET_FAMILY_UNSPEC;
+    has      $.proto      = PIO::PROTO_TCP;
+    has      $.type       = PIO::SOCK_STREAM;
+
+    # XXX: this could be a bit smarter about how it deals with unspecified
+    # families...
+    my sub split-host-port(:$host is copy, :$port is copy, :$family) {
+        if ($host) {
+            my ($split-host, $split-port) = $family == nqp::const::SOCKET_FAMILY_INET6
+                ?? v6-split($host)
+                !! v4-split($host);
+
+            if $split-port {
+                $host = $split-host.Str;
+                $port //= $split-port.Int
+            }
+        }
+
+        fail "Invalid port $port.gist(). Must be {PIO::MIN_PORT}..{PIO::MAX_PORT}"
+            unless $port.defined and PIO::MIN_PORT <= $port <= PIO::MAX_PORT;
+
+        return ($host, $port);
+    }
+
+    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;
+    }
+
+    # Create new socket that listens on $localhost:$localport
+    multi method new(
+        Bool   :$listen! where .so,
+        Str    :$localhost is copy,
+        Int    :$localport is copy,
+        Int    :$family where {
+                $family == nqp::const::SOCKET_FAMILY_UNSPEC
+             || $family == nqp::const::SOCKET_FAMILY_INET
+             || $family == nqp::const::SOCKET_FAMILY_INET6
+        } = nqp::const::SOCKET_FAMILY_UNSPEC,
+               *%rest,
+        --> IO::Socket::INET:D) {
+
+        ($localhost, $localport) = (
+            split-host-port :host($localhost), :port($localport), :$family
+        orelse fail $_);
+
+        #TODO: Learn what protocols map to which socket types and then determine which is needed.
+        self.bless(
+            :$localhost,
+            :$localport,
+            :$family,
+            :listening($listen),
+            |%rest,
+        )!initialize()
+    }
+
+    # Open new connection to socket on $host:$port
+    multi method new(
+        Str:D :$host! is copy,
+        Int   :$port is copy,
+        Int   :$family where {
+               $family == nqp::const::SOCKET_FAMILY_UNSPEC
+            || $family == nqp::const::SOCKET_FAMILY_INET
+            || $family == nqp::const::SOCKET_FAMILY_INET6
+        } = nqp::const::SOCKET_FAMILY_UNSPEC,
+              *%rest,
+        --> IO::Socket::INET:D) {
+
+        ($host, $port) = split-host-port(
+            :$host,
+            :$port,
+            :$family,
+        );
+
+        # TODO: Learn what protocols map to which socket types and then determine which is needed.
+        self.bless(
+            :$host,
+            :$port,
+            :$family,
+            |%rest,
+        )!initialize()
+    }
+
+    # Fail if no valid parameters are passed
+    multi method new() {
+        fail "Nothing given for new socket to connect or bind to. "
+            ~ "Invalid arguments to .new?";
+    }
+
+    method !initialize() {
+        my $PIO := nqp::socket($!listening ?? 10 !! 0);
+
+        # 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 $!listening || $!localhost || $!localport {
+            nqp::bindsock($PIO, nqp::unbox_s($!localhost || "0.0.0.0"),
+                                 nqp::unbox_i($!localport || 0), nqp::unbox_i($!family),
+                                 nqp::unbox_i($!backlog || 128));
+        }
+
+        if $!listening {
+#?if !js
+            $!localport = nqp::getport($PIO) if !$!localport;
+#?endif
+        }
+        elsif $!type == PIO::SOCK_STREAM {
+            nqp::connect($PIO, nqp::unbox_s($!host), nqp::unbox_i($!port), nqp::unbox_i($!family));
+        }
+
+        nqp::bindattr(self, $?CLASS, '$!PIO', $PIO);
+        self;
+    }
+
+    method connect(IO::Socket::INET:U: Str() $host, Int() $port) {
+        self.new(:$host, :$port)
+    }
+
+    method listen(IO::Socket::INET:U: Str() $localhost, Int() $localport) {
+        self.new(:$localhost, :$localport, :listen)
+    }
+
+    method accept() {
+        # A solution as proposed by moritz
+        my $new_sock := $?CLASS.bless(:$!family, :$!proto, :$!type, :$!nl-in);
+        nqp::bindattr($new_sock, $?CLASS, '$!PIO',
+            nqp::accept(nqp::getattr(self, $?CLASS, '$!PIO'))
+        );
+        return $new_sock;
+    }
+}
+
+# vim: ft=perl6 expandtab sw=4
+