1. my class IO::Socket::INET does IO::Socket {
  2. my module PIO {
  3. constant PF_LOCAL = 0;
  4. constant PF_UNIX = 1;
  5. constant PF_INET = 2;
  6. constant PF_INET6 = 3;
  7. constant PF_MAX = 4;
  8. constant SOCK_PACKET = 0;
  9. constant SOCK_STREAM = 1;
  10. constant SOCK_DGRAM = 2;
  11. constant SOCK_RAW = 3;
  12. constant SOCK_RDM = 4;
  13. constant SOCK_SEQPACKET = 5;
  14. constant SOCK_MAX = 6;
  15. constant PROTO_TCP = 6;
  16. constant PROTO_UDP = 17;
  17. constant MIN_PORT = 0;
  18. constant MAX_PORT = 65_535; # RFC 793: TCP/UDP port limit
  19. }
  20. has Str $.encoding = 'utf8';
  21. has Str $.host;
  22. has Int $.port;
  23. has Str $.localhost;
  24. has Int $.localport;
  25. has Int $.backlog;
  26. has Bool $.listening;
  27. has $.family = PIO::PF_INET;
  28. has $.proto = PIO::PROTO_TCP;
  29. has $.type = PIO::SOCK_STREAM;
  30. has $.nl-in is rw = ["\x0A", "\r\n"];
  31. has int $.ins;
  32. my sub split-host-port(:$host is copy, :$port is copy, :$family) {
  33. if ($host) {
  34. my ($split-host, $split-port) = $family == PIO::PF_INET6
  35. ?? v6-split($host)
  36. !! v4-split($host);
  37. if $split-port {
  38. $host = $split-host.Str;
  39. $port //= $split-port.Int
  40. }
  41. }
  42. fail "Invalid port. Must be { PIO::MIN_PORT } .. { PIO::MAX_PORT }"
  43. unless PIO::MIN_PORT <= $port <= PIO::MAX_PORT;
  44. return ($host, $port);
  45. }
  46. my sub v4-split($uri) {
  47. return $uri.split(':', 2);
  48. }
  49. my sub v6-split($uri) {
  50. my ($host, $port) = ($uri ~~ /^'[' (.+) ']' \: (\d+)$/)[0,1];
  51. return $host ?? ($host, $port) !! $uri;
  52. }
  53. # Create new socket that listens on $localhost:$localport
  54. multi method new(
  55. Bool:D :$listen!,
  56. Str :$localhost is copy,
  57. Int :$localport is copy,
  58. Int :$family where {
  59. $family == PIO::PF_INET
  60. || $family == PIO::PF_INET6
  61. } = PIO::PF_INET,
  62. *%rest,
  63. --> IO::Socket::INET:D) {
  64. ($localhost, $localport) = split-host-port(
  65. :host($localhost),
  66. :port($localport),
  67. :$family,
  68. );
  69. #TODO: Learn what protocols map to which socket types and then determine which is needed.
  70. self.bless(
  71. :$localhost,
  72. :$localport,
  73. :$family,
  74. :listening($listen),
  75. |%rest,
  76. )!initialize()
  77. }
  78. # Open new connection to socket on $host:$port
  79. multi method new(
  80. Str:D :$host! is copy,
  81. Int :$port is copy,
  82. Int :$family where {
  83. $family == PIO::PF_INET
  84. || $family == PIO::PF_INET6
  85. } = PIO::PF_INET,
  86. *%rest,
  87. --> IO::Socket::INET:D) {
  88. ($host, $port) = split-host-port(
  89. :$host,
  90. :$port,
  91. :$family,
  92. );
  93. #TODO: Learn what protocols map to which socket types and then determine which is needed.
  94. self.bless(
  95. :$host,
  96. :$port,
  97. :$family,
  98. |%rest,
  99. )!initialize()
  100. }
  101. # Fail if no valid parameters are passed
  102. multi method new() {
  103. fail "Nothing given for new socket to connect or bind to";
  104. }
  105. method !initialize() {
  106. my $PIO := nqp::socket($.listening ?? 10 !! 0);
  107. #Quoting perl5's SIO::INET:
  108. #If Listen is defined then a listen socket is created, else if the socket type,
  109. #which is derived from the protocol, is SOCK_STREAM then connect() is called.
  110. if $.listening || $.localhost || $.localport {
  111. nqp::bindsock($PIO, nqp::unbox_s($.localhost || "0.0.0.0"),
  112. nqp::unbox_i($.localport || 0), nqp::unbox_i($.backlog || 128));
  113. }
  114. if $.listening {
  115. }
  116. elsif $.type == PIO::SOCK_STREAM {
  117. nqp::connect($PIO, nqp::unbox_s($.host), nqp::unbox_i($.port));
  118. }
  119. nqp::bindattr(self, $?CLASS, '$!PIO', $PIO);
  120. self;
  121. }
  122. method connect(IO::Socket::INET:U: Str() $host, Int() $port) {
  123. self.new(:$host, :$port)
  124. }
  125. method listen(IO::Socket::INET:U: Str() $localhost, Int() $localport) {
  126. self.new(:$localhost, :$localport, :listen)
  127. }
  128. method get() {
  129. my Mu $io := nqp::getattr(self, $?CLASS, '$!PIO');
  130. nqp::setencoding($io, Rakudo::Internals.NORMALIZE_ENCODING($!encoding));
  131. Rakudo::Internals.SET_LINE_ENDING_ON_HANDLE($io, $!nl-in);
  132. my str $line = nqp::readlinechompfh($io);
  133. if nqp::chars($line) || !nqp::eoffh($io) {
  134. $!ins = $!ins + 1;
  135. $line
  136. }
  137. else {
  138. Nil
  139. }
  140. }
  141. method lines() {
  142. gather while (my $line = self.get()).DEFINITE {
  143. take $line;
  144. }
  145. }
  146. method accept() {
  147. ## A solution as proposed by moritz
  148. my $new_sock := $?CLASS.bless(:$!family, :$!proto, :$!type, :$!nl-in);
  149. nqp::bindattr($new_sock, $?CLASS, '$!PIO',
  150. nqp::accept(nqp::getattr(self, $?CLASS, '$!PIO'))
  151. );
  152. return $new_sock;
  153. }
  154. }