Created
March 26, 2009 11:12
-
-
Save mberends/86012 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/local/bin/perl6 | |
# sockets-test.pl - trying out Parrot sockets from Rakudo | |
# Interim subs for Parrot (r37707) socket functions (PDD 22) in Rakudo. | |
# Later, when this code moves to rakudo/src/setting/IO.pm, the 'sub' | |
# definitions will become 'method' to augment the IO class. | |
# Later still, the socket functions in Parrot will disappear because | |
# they are deprecated, to be replaced by methods on ParrotIO objects. | |
# When those exist, Rakudo will have access to the methods directly, | |
# making all this PIR code unnecessary. | |
# subs 'Under Construction': nothing works or even makes sense! | |
sub socket( $socket, Int $domain, Int $type, Int $protocol ) { | |
warn "entering socket( socket, $domain, $type, $protocol )"; | |
my $status; | |
$status = Q:PIR{#line 19 "sockets-test.pl" | |
.local pmc sock | |
.local int domain | |
.local int type | |
.local int protocol | |
find_lex sock, "$socket" # socket pmc | |
find_lex $P0, "$domain" # 2=PF_INET (read 'man socket') | |
find_lex $P1, "$type" # 1=SOCK_STREAM ?=SOCK_DGRAM | |
find_lex $P2, "$protocol" # is 6=tcp ?=udp | |
domain = $P0 | |
type = $P1 | |
protocol = $P2 | |
get_hll_global $P3, ["Bool"], "True" # success | |
socket sock, domain, type, protocol | |
if sock goto Sock1 | |
get_hll_global $P3, ["Bool"], "False" # failure | |
Sock1: %r = $P3 | |
}; # returns Bool::True for success or Bool::False for failure | |
warn "socket() returns a status of {$status.perl}"; | |
return $status; | |
} | |
# Problem: returns a pmc, giving errors when passed in a Rakudo scalar: | |
# get_bool() not implemented in class 'Sockaddr' | |
sub sockaddr( Int $port, Str $host ) { | |
# $host examples 'localhost', '127.0.0.1' or 'www.microsoft.com' | |
my $address; | |
warn "entering sockaddr( $port, $host )"; | |
$address = Q:PIR{#line 47 "sockets-test.pl" | |
.local int port | |
.local string host | |
.local pmc address | |
find_lex $P0, "$port" | |
find_lex $P1, "$host" | |
port = $P0 | |
host = $P1 | |
address = sockaddr host, port | |
%r = address | |
}; # returns a Sockaddr object, representing a socket address (address:port) | |
warn "leaving sockaddr()"; | |
return $address; | |
} | |
sub bind( $socket, $packed_address ) { | |
# $packed_address from sockaddr() | |
warn "entering bind()"; | |
return Q:PIR{#line 65 "sockets-test.pl" | |
.local pmc sock | |
.local pmc address | |
.local int status | |
find_lex sock, "$socket" | |
find_lex address, "$packed_address" | |
get_hll_global $P0, ["Bool"], "True" # success | |
# status = 0 | |
status = bind sock, address | |
if status == -1 goto Bind1 | |
get_hll_global $P0, ["Bool"], "False" # failure | |
Bind1: %r = $P0 | |
} # returns Bool::True for success or Bool::False for failure | |
} | |
#sub listen( $socket, Int $queuesize ) { | |
# # returns Bool::True for success or Bool::False for failure | |
# return Q:PIR{#line 82 "sockets-test.pl" | |
# .local pmc sock | |
# .local int queuesize | |
# .local int status | |
# find_lex sock, "$socket" | |
# find_lex queuesize, "$queuesize" | |
# get_hll_global $P0, ["Bool"], "True" # success | |
# status = 0 | |
## listen status, sock, 1 | |
# if status == -1 goto Listen1 | |
# get_hll_global $P0, ["Bool"], "False" # failure | |
#Listen1:%r = $P0 | |
# } | |
#} | |
#sub accept( $connectingsocket, $listeningsocket ) { | |
# # returns the packed remote address for success or Bool::False for failure | |
# return Q:PIR{#line 99 "sockets-test.pl" | |
# get_hll_global $P0, ["Bool"], "False" | |
# .local pmc work | |
# .local pmc sock | |
# accept work, sock | |
# %r = $P0 | |
# } | |
#} | |
# Problem: the sock parameter does not seem to be the one set up by socket(): | |
# Method 'connect' not found for invocant of class 'Failure' | |
sub connect( $socket, Str $remote_address ) { | |
# the Perl 5 version expects a packed binary $address for total C | |
# compatibility, but 'host.domain.com:1234' is nicer. | |
warn "entering connect( socket, remote_address )"; | |
my Bool $status; | |
$status = Q:PIR{#line 115 "sockets-test.pl" | |
.local pmc sock | |
.local string addr | |
.local int status | |
find_lex sock, "$socket" | |
find_lex $P1, "$remote_address" | |
addr = $P1 | |
get_hll_global $P2, ["Bool"], "True" # success | |
# status = -1 # cheat for sanity check | |
status = sock.'connect'(addr) | |
if status == -1 goto Conn1 | |
get_hll_global $P2, ["Bool"], "False" # failure | |
Conn1: %r = $P2 | |
}; | |
warn "connect() returns a status of {$status.perl}"; | |
return $status; | |
} | |
# TODO: send recv | |
# main program to do tests... | |
my $client_socket; | |
my $remote_address; | |
my $request; | |
my $response; | |
socket( $client_socket, 2, 1, 6 ); # PF_INET, SOCK_STREAM, TCP | |
$remote_address = sockaddr( 80, 'www.microsoft.com' ); | |
# evil patch attempt to circumvent problem on sockaddr() | |
$remote_address = chr(127)~chr(0)~chr(0)~chr(1)~chr(0)~chr(25); | |
connect( $client_socket, $remote_address ) || die "cannot connect"; | |
$request = "HEAD / HTTP/1.0\r\nConnection: close\r\n\r\n"; | |
#send( $client_socket, $request ); | |
#$response = recv( $client_socket ); | |
#say $response; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment