Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 181 lines (151 sloc) 5.662 kb
e441498 Stefan O'Rear Minimal implementation of sockets (not in setting yet)
authored
1
2 class IO::Socket::INET {
3 has $!sock;
7ff1b8e Stefan O'Rear Add server sockets to socket test module
authored
4 has Str $!buffer = '';
5
6 # TODO: This code is horribly broken, especially if a character gets cut by
7 # a buffer or packet boundry, or you want to switch from char to binary mode
8 # doing it right seems to require some kind of Decoder class
9
10 method recv (Cool $chars = Inf) {
11 die('Socket not available') unless $!sock;
12
13 if $!buffer.chars < $chars {
14 $!buffer ~= self.read(2048).decode('UTF-8');
15 }
16
17 if $!buffer.chars > $chars {
18 my $rec = $!buffer.substr(0, $chars);
19 $!buffer = $!buffer.substr($chars);
20 $rec
21 } else {
22 my $rec = $!buffer;
23 $!buffer = '';
24 $rec;
25 }
26 }
e441498 Stefan O'Rear Minimal implementation of sockets (not in setting yet)
authored
27
28 method read(IO::Socket::INET:D: Cool $bufsize) {
29 die('Socket not available') unless $!sock;
30 Q:CgOp { (box Buf (socket_read (unbox socket {$!sock}) (unbox int {$bufsize.Int}))) }
31 }
32
33 #method poll(Int $bitmask, $seconds) {
34 # $!sock.poll(
35 # nqp::unbox_i($bitmask), nqp::unbox_i($seconds.floor),
36 # nqp::unbox_i((($seconds - $seconds.floor) * 1000).Int)
37 # );
38 #}
39
40 method send (Cool $string) {
41 self.write($string.encode('UTF-8'));
42 }
43
44 method write(Buf:D $buf) {
45 die('Socket not available') unless $!sock;
46 Q:CgOp { (rnull (socket_write (unbox socket {$!sock}) (unbox blob {$buf}))) }
47 }
48
49 method close () {
50 die("Not connected!") unless $!sock;
51 Q:CgOp { (rnull (socket_close (unbox socket {$!sock}))) };
52 $!sock = Any;
53 }
54
55 my module sock {
56 # XXX these constants are backend-sensitive.
57 constant PF_LOCAL = 0;
58 constant PF_UNIX = 1;
59 constant PF_INET = 2;
60 constant PF_INET6 = 0x17;
61 #constant PF_MAX = 4;
62 #constant SOCK_PACKET = 0;
63 constant SOCK_STREAM = 1;
64 constant SOCK_DGRAM = 2;
65 constant SOCK_RAW = 3;
66 constant SOCK_RDM = 4;
67 constant SOCK_SEQPACKET = 5;
68 constant SOCK_MAX = 6;
69 constant PROTO_TCP = 6;
70 constant PROTO_UDP = 17;
71 }
72
73 has Str $.host;
74 has Int $.port = 80;
75 has Str $.localhost;
76 has Int $.localport;
77 has Bool $.listen;
78 has $.family = sock::PF_INET;
79 has $.proto = sock::PROTO_TCP;
80 has $.type = sock::SOCK_STREAM;
81 has Str $.input-line-separator is rw = "\n";
82 has Int $.ins = 0;
83
84 my sub v4-split($uri) {
85 return $uri.split(':', 2);
86 }
87
88 my sub v6-split($uri) {
89 my ($host, $port) = ($uri ~~ /^'[' (.+) ']' \: (\d+)$/)[0,1];
90 return $host ?? ($host, $port) !! $uri;
91 }
92
93 method new (*%args is copy) {
94 die "Nothing given for new socket to connect or bind to" unless %args<host> || %args<listen>;
95
96 if %args<host> {
97 my ($host, $port) = %args<family> && %args<family> == sock::PF_INET6()
98 ?? v6-split(%args<host>)
99 !! v4-split(%args<host>);
100 if $port {
101 %args<port> //= $port;
102 %args<host> = $host;
103 }
104 }
105 if %args<localhost> {
106 my ($peer, $port) = %args<family> && %args<family> == sock::PF_INET6()
107 ?? v6-split(%args<localhost>)
108 !! v4-split(%args<localhost>);
109 if $port {
110 %args<localport> //= $port;
111 %args<localhost> = $peer;
112 }
113 }
114
115 %args<listen>.=Bool if %args<listen> :exists;
116
117 #TODO: Learn what protocols map to which socket types and then determine which is needed.
118 self.bless(*, |%args)!initialize()
119 }
120
121 method !initialize() {
122 $!sock = Q:CgOp { (box Any (socket_new (unbox int {$.family}) (unbox int {$.type}) (unbox int {$.proto}))) };
123
124 #Quoting perl5's SIO::INET:
125 #If Listen is defined then a listen socket is created, else if the socket type,
126 #which is derived from the protocol, is SOCK_STREAM then connect() is called.
127 if $.listen || $.localhost || $.localport {
7ff1b8e Stefan O'Rear Add server sockets to socket test module
authored
128 Q:CgOp { (rnull (socket_bind (unbox socket {$!sock}) (unbox str {$.localhost || "0.0.0.0"}) (unbox int {$.localport || 0}))) };
e441498 Stefan O'Rear Minimal implementation of sockets (not in setting yet)
authored
129 }
130
131 if $.listen {
7ff1b8e Stefan O'Rear Add server sockets to socket test module
authored
132 Q:CgOp { (rnull (socket_listen (unbox socket {$!sock}) (unbox int {20}))) };
e441498 Stefan O'Rear Minimal implementation of sockets (not in setting yet)
authored
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
7ff1b8e Stefan O'Rear Add server sockets to socket test module
authored
141 method get() {
142 ++$!ins;
143 my $inbuf = '';
144 my $irs = $!input-line-separator;
145 my $irslen = chars($irs);
146 until substr($inbuf, chars($inbuf)-$irslen, $irslen) eq $irs {
147 $inbuf ~= (self.recv(1) || return $inbuf);
148 }
149 substr($inbuf, 0, chars($inbuf)-$irslen);
150 }
e441498 Stefan O'Rear Minimal implementation of sockets (not in setting yet)
authored
151
7ff1b8e Stefan O'Rear Add server sockets to socket test module
authored
152 method lines() {
153 gather { take self.get() };
154 }
e441498 Stefan O'Rear Minimal implementation of sockets (not in setting yet)
authored
155
7ff1b8e Stefan O'Rear Add server sockets to socket test module
authored
156 method !setsock($ns) {
157 $!sock = $ns;
158 $!buffer = '';
159 self;
160 }
161
162 method accept() {
163 my $new_sock := self.WHAT.bless(*, :$!family, :$!proto, :$!type);
164 $new_sock!setsock( Q:CgOp { (box Any (socket_accept (unbox socket {$!sock}))) } );
165 }
e441498 Stefan O'Rear Minimal implementation of sockets (not in setting yet)
authored
166
167 #method remote_address() {
168 # return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!sock').remote_address());
169 #}
170
171 #method local_address() {
172 # return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!sock').local_address());
173 #}
174 }
175
7ff1b8e Stefan O'Rear Add server sockets to socket test module
authored
176 my $sock = IO::Socket::INET.new( localport => 9999, :listen );
177 while $sock.accept -> $new {
178 say "<< $new.get() >>";
179 $new.close;
180 }
Something went wrong with that request. Please try again.