-
-
Notifications
You must be signed in to change notification settings - Fork 373
/
INET.pm
192 lines (170 loc) Β· 5.73 KB
/
INET.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
my class IO::Socket::INET does IO::Socket {
my module PIO {
constant PF_LOCAL = 0;
constant PF_UNIX = 1;
constant PF_INET = 2;
constant PF_INET6 = 3;
constant PF_MAX = 4;
constant SOCK_PACKET = 0;
constant SOCK_STREAM = 1;
constant SOCK_DGRAM = 2;
constant SOCK_RAW = 3;
constant SOCK_RDM = 4;
constant SOCK_SEQPACKET = 5;
constant SOCK_MAX = 6;
constant PROTO_TCP = 6;
constant PROTO_UDP = 17;
}
has Str $.encoding = 'utf8';
has Str $.host;
has Int $.port = 80;
has Str $.localhost;
has Int $.localport;
has Bool $.listen;
has $.family = PIO::PF_INET;
has $.proto = PIO::PROTO_TCP;
has $.type = PIO::SOCK_STREAM;
has Str $.input-line-separator is rw = "\n";
has Int $.ins = 0;
my sub v4-split($uri) {
return $uri.split(':', 2);
}
my sub v6-split($uri) {
my ($host, $port) = ($uri ~~ /^'[' (.+) ']' \: (\d+)$/)[0,1];
return $host ?? ($host, $port) !! $uri;
}
method new (*%args is copy) {
fail "Nothing given for new socket to connect or bind to" unless %args<host> || %args<listen>;
if %args<host> {
my ($host, $port) = %args<family> && %args<family> == PIO::PF_INET6()
?? v6-split(%args<host>)
!! v4-split(%args<host>);
if $port {
%args<port> //= $port;
%args<host> = $host;
}
}
if %args<localhost> {
my ($peer, $port) = %args<family> && %args<family> == PIO::PF_INET6()
?? v6-split(%args<localhost>)
!! v4-split(%args<localhost>);
if $port {
%args<localport> //= $port;
%args<localhost> = $peer;
}
}
%args<listen>.=Bool if %args.exists_key('listen');
#TODO: Learn what protocols map to which socket types and then determine which is needed.
self.bless(|%args)!initialize()
}
method !initialize() {
#?if parrot
my $PIO := Q:PIR { %r = root_new ['parrot';'Socket'] };
$PIO.socket($.family, $.type, $.proto);
#?endif
#?if !parrot
my $PIO := nqp::socket($.listen ?? 10 !! 0);
#?endif
#Quoting perl5's SIO::INET:
#If Listen is defined then a listen socket is created, else if the socket type,
#which is derived from the protocol, is SOCK_STREAM then connect() is called.
if $.listen || $.localhost || $.localport {
#?if parrot
my $addr := $PIO.sockaddr($.localhost || "0.0.0.0", $.localport || 0);
$PIO.bind($addr);
#?endif
#?if !parrot
nqp::bindsock($PIO, nqp::unbox_s($.localhost || "0.0.0.0"),
nqp::unbox_i($.localport || 0));
#?endif
}
if $.listen {
#?if parrot
$PIO.listen($.listen);
#?endif
}
elsif $.type == PIO::SOCK_STREAM {
#?if parrot
my $addr := $PIO.sockaddr($.host, $.port);
$PIO.connect($addr);
#?endif
#?if !parrot
nqp::connect($PIO, nqp::unbox_s($.host), nqp::unbox_i($.port));
#?endif
}
nqp::bindattr(self, $?CLASS, '$!PIO', $PIO);
self;
}
method get() {
#?if parrot
my str $encoding = nqp::unbox_s(NORMALIZE_ENCODING($!encoding));
my str $sep = pir::trans_encoding__SSI(
nqp::unbox_s($!input-line-separator),
pir::find_encoding__IS($encoding));
my int $sep-len = nqp::chars($sep);
my Mu $PIO := nqp::getattr(self, $?CLASS, '$!PIO');
$PIO.encoding($encoding);
my str $line = $PIO.readline($sep);
#?endif
#?if jvm
my str $sep = nqp::unbox_s($!input-line-separator);
my int $sep-len = nqp::chars($sep);
my Mu $io := nqp::getattr(self, $?CLASS, '$!PIO');
nqp::setencoding($io, nqp::unbox_s($!encoding));
nqp::setinputlinesep($io, $sep);
my Str $line = nqp::p6box_s(nqp::readlinefh($io));
#?endif
#?if moar
my str $sep = nqp::unbox_s($!input-line-separator);
my int $sep-len = nqp::chars($sep);
my Mu $io := nqp::getattr(self, $?CLASS, '$!PIO');
nqp::setencoding($io, nqp::unbox_s($!encoding));
nqp::setinputlinesep($io, $sep);
my Str $line = nqp::p6box_s(nqp::readlinefh($io));
#?endif
my int $len = nqp::chars($line);
if $len == 0 { Str }
else {
++$!ins;
$len >= $sep-len && nqp::substr($line, $len - $sep-len) eq $sep
?? nqp::p6box_s(nqp::substr($line, 0, $len - $sep-len))
!! nqp::p6box_s($line);
}
#?endif
}
method lines() {
gather while (my $line = self.get()).defined {
take $line;
}
}
method accept() {
## A solution as proposed by moritz
my $new_sock := $?CLASS.bless(:$!family, :$!proto, :$!type, :$!input-line-separator);
#?if parrot
nqp::getattr($new_sock, $?CLASS, '$!buffer') = '';
#?endif
#?if jvm
nqp::getattr($new_sock, $?CLASS, '$!buffer') = buf8.new;
#?endif
nqp::bindattr($new_sock, $?CLASS, '$!PIO',
#?if parrot
nqp::getattr(self, $?CLASS, '$!PIO').accept()
#?endif
#?if !parrot
nqp::accept(nqp::getattr(self, $?CLASS, '$!PIO'))
#?endif
);
return $new_sock;
}
method remote_address() {
#?if parrot
return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!PIO').remote_address());
#?endif
}
method local_address() {
#?if parrot
return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!PIO').local_address());
#?endif
}
}
# vim: ft=perl6 expandtab sw=4