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 $port.gist(). Must be {PIO::MIN_PORT}..{PIO::MAX_PORT}"
  40. unless $port.defined and 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) = (
  62. split-host-port :host($localhost), :port($localport), :$family
  63. orelse fail $_);
  64. #TODO: Learn what protocols map to which socket types and then determine which is needed.
  65. self.bless(
  66. :$localhost,
  67. :$localport,
  68. :$family,
  69. :listening($listen),
  70. |%rest,
  71. )!initialize()
  72. }
  73. # Open new connection to socket on $host:$port
  74. multi method new(
  75. Str:D :$host! is copy,
  76. Int :$port is copy,
  77. Int :$family where {
  78. $family == PIO::PF_INET
  79. || $family == PIO::PF_INET6
  80. } = PIO::PF_INET,
  81. *%rest,
  82. --> IO::Socket::INET:D) {
  83. ($host, $port) = split-host-port(
  84. :$host,
  85. :$port,
  86. :$family,
  87. );
  88. #TODO: Learn what protocols map to which socket types and then determine which is needed.
  89. self.bless(
  90. :$host,
  91. :$port,
  92. :$family,
  93. |%rest,
  94. )!initialize()
  95. }
  96. # Fail if no valid parameters are passed
  97. multi method new() {
  98. fail "Nothing given for new socket to connect or bind to. "
  99. ~ "Invalid arguments to .new?";
  100. }
  101. method !initialize() {
  102. my $PIO := nqp::socket($.listening ?? 10 !! 0);
  103. #Quoting perl5's SIO::INET:
  104. #If Listen is defined then a listen socket is created, else if the socket type,
  105. #which is derived from the protocol, is SOCK_STREAM then connect() is called.
  106. if $.listening || $.localhost || $.localport {
  107. nqp::bindsock($PIO, nqp::unbox_s($.localhost || "0.0.0.0"),
  108. nqp::unbox_i($.localport || 0), nqp::unbox_i($.backlog || 128));
  109. }
  110. if $.listening {
  111. $!localport = nqp::getport($PIO) if !$!localport;
  112. }
  113. elsif $.type == PIO::SOCK_STREAM {
  114. nqp::connect($PIO, nqp::unbox_s($.host), nqp::unbox_i($.port));
  115. }
  116. nqp::bindattr(self, $?CLASS, '$!PIO', $PIO);
  117. self;
  118. }
  119. method connect(IO::Socket::INET:U: Str() $host, Int() $port) {
  120. self.new(:$host, :$port)
  121. }
  122. method listen(IO::Socket::INET:U: Str() $localhost, Int() $localport) {
  123. self.new(:$localhost, :$localport, :listen)
  124. }
  125. method accept() {
  126. ## A solution as proposed by moritz
  127. my $new_sock := $?CLASS.bless(:$!family, :$!proto, :$!type, :$!nl-in);
  128. nqp::bindattr($new_sock, $?CLASS, '$!PIO',
  129. nqp::accept(nqp::getattr(self, $?CLASS, '$!PIO'))
  130. );
  131. return $new_sock;
  132. }
  133. }