Mercurial > hg > Others > Abyss-Server
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
--- 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 +