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 $.host;
  21. has Int $.port;
  22. has Str $.localhost;
  23. has Int $.localport;
  24. has Int $.backlog;
  25. has Bool $.listening;
  26. has $.family = PIO::PF_INET;
  27. has $.proto = PIO::PROTO_TCP;
  28. has $.type = PIO::SOCK_STREAM;
  29. my sub split-host-port(:$host is copy, :$port is copy, :$family) {
  30. if ($host) {
  31. my ($split-host, $split-port) = $family == PIO::PF_INET6
  32. ?? v6-split($host)
  33. !! v4-split($host);
  34. if $split-port {
  35. $host = $split-host.Str;
  36. $port //= $split-port.Int
  37. }
  38. }
  39. fail "Invalid port. Must be { PIO::MIN_PORT } .. { PIO::MAX_PORT }"
  40. unless PIO::MIN_PORT <= $port <= PIO::MAX_PORT;
  41. return ($host, $port);
  42. }
  43. my sub v4-split($uri) {
  44. return $uri.split(':', 2);
  45. }
  46. my sub v6-split($uri) {
  47. my ($host, $port) = ($uri ~~ /^'[' (.+) ']' \: (\d+)$/)[0,1];
  48. return $host ?? ($host, $port) !! $uri;
  49. }
  50. # Create new socket that listens on $localhost:$localport
  51. multi method new(
  52. Bool:D :$listen!,
  53. Str :$localhost is copy,
  54. Int :$localport is copy,
  55. Int :$family where {
  56. $family == PIO::PF_INET
  57. || $family == PIO::PF_INET6
  58. } = PIO::PF_INET,
  59. *%rest,
  60. --> IO::Socket::INET:D) {
  61. ($localhost, $localport) = split-host-port(
  62. :host($localhost),
  63. :port($localport),
  64. :$family,
  65. );
  66. #TODO: Learn what protocols map to which socket types and then determine which is needed.
  67. self.bless(
  68. :$localhost,
  69. :$localport,
  70. :$family,
  71. :listening($listen),
  72. |%rest,
  73. )!initialize()
  74. }
  75. # Open new connection to socket on $host:$port
  76. multi method new(
  77. Str:D :$host! is copy,
  78. Int :$port is copy,
  79. Int :$family where {
  80. $family == PIO::PF_INET
  81. || $family == PIO::PF_INET6
  82. } = PIO::PF_INET,
  83. *%rest,
  84. --> IO::Socket::INET:D) {
  85. ($host, $port) = split-host-port(
  86. :$host,
  87. :$port,
  88. :$family,
  89. );
  90. #TODO: Learn what protocols map to which socket types and then determine which is needed.
  91. self.bless(
  92. :$host,
  93. :$port,
  94. :$family,
  95. |%rest,
  96. )!initialize()
  97. }
  98. # Fail if no valid parameters are passed
  99. multi method new() {
  100. fail "Nothing given for new socket to connect or bind to";
  101. }
  102. method !initialize() {
  103. my $PIO := nqp::socket($.listening ?? 10 !! 0);
  104. #Quoting perl5's SIO::INET:
  105. #If Listen is defined then a listen socket is created, else if the socket type,
  106. #which is derived from the protocol, is SOCK_STREAM then connect() is called.
  107. if $.listening || $.localhost || $.localport {
  108. nqp::bindsock($PIO, nqp::unbox_s($.localhost || "0.0.0.0"),
  109. nqp::unbox_i($.localport || 0), nqp::unbox_i($.backlog || 128));
  110. }
  111. if $.listening {
  112. $!localport = nqp::getport($PIO) if !$!localport;
  113. }
  114. elsif $.type == PIO::SOCK_STREAM {
  115. nqp::connect($PIO, nqp::unbox_s($.host), nqp::unbox_i($.port));
  116. }
  117. nqp::bindattr(self, $?CLASS, '$!PIO', $PIO);
  118. self;
  119. }
  120. method connect(IO::Socket::INET:U: Str() $host, Int() $port) {
  121. self.new(:$host, :$port)
  122. }
  123. method listen(IO::Socket::INET:U: Str() $localhost, Int() $localport) {
  124. self.new(:$localhost, :$localport, :listen)
  125. }
  126. method accept() {
  127. ## A solution as proposed by moritz
  128. my $new_sock := $?CLASS.bless(:$!family, :$!proto, :$!type, :$!nl-in);
  129. nqp::bindattr($new_sock, $?CLASS, '$!PIO',
  130. nqp::accept(nqp::getattr(self, $?CLASS, '$!PIO'))
  131. );
  132. return $new_sock;
  133. }
  134. }