Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Minimal implementation of sockets (not in setting yet)

  • Loading branch information...
commit e441498ee8874c1112127d3d09189b63fb449da9 1 parent ec0eab3
Stefan O'Rear sorear authored

Showing 1 changed file with 176 additions and 0 deletions. Show diff stats Hide diff stats

  1. +176 0 examples/sock.pl
176 examples/sock.pl
... ... @@ -0,0 +1,176 @@
  1 +
  2 +class IO::Socket::INET {
  3 + has $!sock;
  4 + #has Buf $!buf;
  5 +
  6 + #method recv (Cool $chars = Inf) {
  7 + # die('Socket not available') unless $!sock;
  8 +
  9 + # if $!buffer.chars < $chars {
  10 + # my str $r = $!sock.recv;
  11 + # $r = pir::trans_encoding__SSI($r,
  12 + # pir::find_encoding__Is('utf8'));
  13 + # $!buffer ~= nqp::p6box_s($r);
  14 + # }
  15 +
  16 + # if $!buffer.chars > $chars {
  17 + # my $rec = $!buffer.substr(0, $chars);
  18 + # $!buffer = $!buffer.substr($chars);
  19 + # $rec
  20 + # } else {
  21 + # my $rec = $!buffer;
  22 + # $!buffer = '';
  23 + # $rec;
  24 + # }
  25 + #}
  26 +
  27 + method read(IO::Socket::INET:D: Cool $bufsize) {
  28 + die('Socket not available') unless $!sock;
  29 + Q:CgOp { (box Buf (socket_read (unbox socket {$!sock}) (unbox int {$bufsize.Int}))) }
  30 + }
  31 +
  32 + #method poll(Int $bitmask, $seconds) {
  33 + # $!sock.poll(
  34 + # nqp::unbox_i($bitmask), nqp::unbox_i($seconds.floor),
  35 + # nqp::unbox_i((($seconds - $seconds.floor) * 1000).Int)
  36 + # );
  37 + #}
  38 +
  39 + method send (Cool $string) {
  40 + self.write($string.encode('UTF-8'));
  41 + }
  42 +
  43 + method write(Buf:D $buf) {
  44 + die('Socket not available') unless $!sock;
  45 + Q:CgOp { (rnull (socket_write (unbox socket {$!sock}) (unbox blob {$buf}))) }
  46 + }
  47 +
  48 + method close () {
  49 + die("Not connected!") unless $!sock;
  50 + Q:CgOp { (rnull (socket_close (unbox socket {$!sock}))) };
  51 + $!sock = Any;
  52 + }
  53 +
  54 + my module sock {
  55 + # XXX these constants are backend-sensitive.
  56 + constant PF_LOCAL = 0;
  57 + constant PF_UNIX = 1;
  58 + constant PF_INET = 2;
  59 + constant PF_INET6 = 0x17;
  60 + #constant PF_MAX = 4;
  61 + #constant SOCK_PACKET = 0;
  62 + constant SOCK_STREAM = 1;
  63 + constant SOCK_DGRAM = 2;
  64 + constant SOCK_RAW = 3;
  65 + constant SOCK_RDM = 4;
  66 + constant SOCK_SEQPACKET = 5;
  67 + constant SOCK_MAX = 6;
  68 + constant PROTO_TCP = 6;
  69 + constant PROTO_UDP = 17;
  70 + }
  71 +
  72 + has Str $.host;
  73 + has Int $.port = 80;
  74 + has Str $.localhost;
  75 + has Int $.localport;
  76 + has Bool $.listen;
  77 + has $.family = sock::PF_INET;
  78 + has $.proto = sock::PROTO_TCP;
  79 + has $.type = sock::SOCK_STREAM;
  80 + has Str $.input-line-separator is rw = "\n";
  81 + has Int $.ins = 0;
  82 +
  83 + my sub v4-split($uri) {
  84 + return $uri.split(':', 2);
  85 + }
  86 +
  87 + my sub v6-split($uri) {
  88 + my ($host, $port) = ($uri ~~ /^'[' (.+) ']' \: (\d+)$/)[0,1];
  89 + return $host ?? ($host, $port) !! $uri;
  90 + }
  91 +
  92 + method new (*%args is copy) {
  93 + die "Nothing given for new socket to connect or bind to" unless %args<host> || %args<listen>;
  94 +
  95 + if %args<host> {
  96 + my ($host, $port) = %args<family> && %args<family> == sock::PF_INET6()
  97 + ?? v6-split(%args<host>)
  98 + !! v4-split(%args<host>);
  99 + if $port {
  100 + %args<port> //= $port;
  101 + %args<host> = $host;
  102 + }
  103 + }
  104 + if %args<localhost> {
  105 + my ($peer, $port) = %args<family> && %args<family> == sock::PF_INET6()
  106 + ?? v6-split(%args<localhost>)
  107 + !! v4-split(%args<localhost>);
  108 + if $port {
  109 + %args<localport> //= $port;
  110 + %args<localhost> = $peer;
  111 + }
  112 + }
  113 +
  114 + %args<listen>.=Bool if %args<listen> :exists;
  115 +
  116 + #TODO: Learn what protocols map to which socket types and then determine which is needed.
  117 + self.bless(*, |%args)!initialize()
  118 + }
  119 +
  120 + method !initialize() {
  121 + $!sock = Q:CgOp { (box Any (socket_new (unbox int {$.family}) (unbox int {$.type}) (unbox int {$.proto}))) };
  122 +
  123 + #Quoting perl5's SIO::INET:
  124 + #If Listen is defined then a listen socket is created, else if the socket type,
  125 + #which is derived from the protocol, is SOCK_STREAM then connect() is called.
  126 + if $.listen || $.localhost || $.localport {
  127 + #my $addr := $sock.sockaddr($.localhost || "0.0.0.0", $.localport || 0);
  128 + #$sock.bind($addr);
  129 + }
  130 +
  131 + if $.listen {
  132 + #$sock.listen($.listen);
  133 + }
  134 + elsif $.type == sock::SOCK_STREAM {
  135 + Q:CgOp { (rnull (socket_connect (unbox socket {$!sock}) (unbox str {$.host}) (unbox int {$.port}))) };
  136 + }
  137 +
  138 + self;
  139 + }
  140 +
  141 + #method get() {
  142 + # ++$!ins;
  143 + # my str $line = nqp::getattr(self, $?CLASS, '$!sock').readline(nqp::unbox_s($!input-line-separator));
  144 + # my str $sep = $!input-line-separator;
  145 + # my int $len = nqp::chars($line);
  146 + # my int $sep-len = nqp::chars($sep);
  147 + # $len >= $sep-len && nqp::substr($line, $len - $sep-len) eq nqp::unbox_s($sep)
  148 + # ?? nqp::p6box_s(nqp::substr($line, 0, $len - $sep-len))
  149 + # !! nqp::p6box_s($line);
  150 + #}
  151 +
  152 + #method lines() {
  153 + # gather { take self.get() };
  154 + #}
  155 +
  156 + #method accept() {
  157 + # #my $new_sock := nqp::create($?CLASS);
  158 + # ## A solution as proposed by moritz
  159 + # my $new_sock := $?CLASS.bless(*, :$!family, :$!proto, :$!type);
  160 + # nqp::getattr($new_sock, $?CLASS, '$!buffer') = '';
  161 + # nqp::bindattr($new_sock, $?CLASS, '$!sock', nqp::getattr(self, $?CLASS, '$!sock').accept());
  162 + # return $new_sock;
  163 + #}
  164 +
  165 + #method remote_address() {
  166 + # return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!sock').remote_address());
  167 + #}
  168 +
  169 + #method local_address() {
  170 + # return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!sock').local_address());
  171 + #}
  172 +}
  173 +
  174 +my $sock = IO::Socket::INET.new( host => 'perl6.org', port => 80 );
  175 +$sock.send("GET / HTTP/1.0\cJ\cM\cJ\cM");
  176 +say $sock.read(16384).decode('UTF-8');

0 comments on commit e441498

Please sign in to comment.
Something went wrong with that request. Please try again.