gforth/unix/socket.fs - diff

Return to socket.fs CVS log

Up to [gforth] / gforth / unix

Diff for /gforth/unix/socket.fs between versions 1.40 and 1.41

version 1.40, 2011/01/09 20:04:15	version 1.41, 2011/02/26 20:53:29
Line 19	Line 19

c-library socket	c-library socket
\c #include <netdb.h>	\c #include <netdb.h>
c-function gethostbyname gethostbyname a -- a ( name -- hostent )
\c #include <unistd.h>	\c #include <unistd.h>
c-function gethostname gethostname a n -- n ( c-addr u -- ior )	c-function gethostname gethostname a n -- n ( c-addr u -- ior )
\c #include <errno.h>	\c #include <errno.h>
Line 54 c-function ppoll ppoll a n a a -- n ( fd	Line 53 c-function ppoll ppoll a n a a -- n ( fd
c-function getaddrinfo getaddrinfo a a a a -- n ( node service hints res -- r )	c-function getaddrinfo getaddrinfo a a a a -- n ( node service hints res -- r )
c-function freeaddrinfo freeaddrinfo a -- void ( res -- )	c-function freeaddrinfo freeaddrinfo a -- void ( res -- )
c-function gai_strerror gai_strerror n -- a ( errcode -- addr )	c-function gai_strerror gai_strerror n -- a ( errcode -- addr )
	c-function setsockopt setsockopt n n n a n -- n ( sockfd level optname optval optlen -- r )
end-c-library	end-c-library

4 4 2Constant int%	4 4 2Constant int%
Line 73 struct	Line 73 struct
short% field port	short% field port
int% field sin_addr	int% field sin_addr
cell% 2* field padding	cell% 2* field padding
end-struct sockaddr_in	end-struct sockaddr_in4

	struct
	short% field sin6_family
	short% field sin6_port
	int% field sin6_flowinfo
	int% 4 * field sin6_addr
	int% field sin6_scope_id
	end-struct sockaddr_in6

	sockaddr_in4 %alignment sockaddr_in6 %alignment max
	sockaddr_in4 %size sockaddr_in6 %size max 2Constant sockaddr_in

struct	struct
int% field fd	int% field fd
Line 99 sockaddr-tmp sockaddr_in %size dup allot	Line 110 sockaddr-tmp sockaddr_in %size dup allot
Create hints	Create hints
hints addrinfo %size dup allot erase	hints addrinfo %size dup allot erase
Variable addrres	Variable addrres
	Variable sockopt-on

: c-string ( addr u -- addr' )	: c-string ( addr u -- addr' )
tuck pad swap move pad + 0 swap c! pad ;	tuck pad swap move pad + 0 swap c! pad ;

: host>addr ( addr u -- x )
\G converts a internet name into a IPv4 address
\G the resulting address is in network byte order
c-string gethostbyname dup 0= abort" address not found"
[ s" os-type" environment? drop s" cygwin" str= ] [IF]
&12 +
[ELSE]
h_addr_list
[THEN]
@ @ l@ ntohl ;

0 Constant PF_UNSPEC	0 Constant PF_UNSPEC
2 Constant PF_INET	2 Constant PF_INET
	10 Constant PF_INET6
1 Constant SOCK_STREAM	1 Constant SOCK_STREAM
2 Constant SOCK_DGRAM	2 Constant SOCK_DGRAM
1 Constant IPPROTO_ICMP	1 Constant IPPROTO_ICMP
6 Constant IPPROTO_TCP	6 Constant IPPROTO_TCP
17 Constant IPPROTO_UDP	17 Constant IPPROTO_UDP
	26 Constant IPV6_V6ONLY
	41 Constant IPPROTO_IPV6
4 Constant F_SETFL	4 Constant F_SETFL
11 Constant EWOULDBLOCK	11 Constant EWOULDBLOCK
$100 Constant MSG_WAITALL	$100 Constant MSG_WAITALL
Line 135 $004 Constant POLLOUT	Line 139 $004 Constant POLLOUT
PF_INET SOCK_STREAM 0 socket	PF_INET SOCK_STREAM 0 socket
dup 0<= abort" no free socket" ;	dup 0<= abort" no free socket" ;

	: new-socket6 ( -- socket )
	PF_INET6 SOCK_STREAM 0 socket
	dup 0<= abort" no free socket"
	dup IPPROTO_IPV6 IPV6_V6ONLY sockopt-on dup on 4 setsockopt drop ;

: new-udp-socket ( -- socket )	: new-udp-socket ( -- socket )
PF_INET SOCK_DGRAM 0 socket	PF_INET SOCK_DGRAM 0 socket
dup 0<= abort" no free socket" ;	dup 0<= abort" no free socket" ;

: >inetaddr ( ip port sockaddr -- ) >r	: new-udp-socket6 ( -- socket )
r@ sockaddr_in %size erase	PF_INET6 SOCK_DGRAM 0 socket
PF_INET r@ family w!	dup 0<= abort" no free socket"
htons r@ port w!	dup IPPROTO_IPV6 IPV6_V6ONLY sockopt-on dup on 4 setsockopt drop ;
htonl r> sin_addr l! ;

: open-socket1 ( addr u port -- fid )
-rot host>addr
swap sockaddr-tmp >inetaddr
new-socket >r
r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"
r> s" w+" c-string fdopen ;

: open-udp-socket1 ( addr u port -- fid )
-rot host>addr
swap sockaddr-tmp >inetaddr
new-udp-socket >r
r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"
r> s" w+" c-string fdopen ;

\ getaddrinfo based open-socket	\ getaddrinfo based open-socket

Line 201 $004 Constant POLLOUT	Line 195 $004 Constant POLLOUT
htons sockaddr-tmp port w!	htons sockaddr-tmp port w!
new-socket	new-socket
dup 0< abort" no free socket" >r	dup 0< abort" no free socket" >r
r@ sockaddr-tmp 16 bind 0= IF r> exit ENDIF	r@ sockaddr-tmp sockaddr_in4 %size bind 0= IF r> exit ENDIF
	r> drop true abort" bind :: failed" ;

	: create-server6 ( port# -- lsocket )
	sockaddr-tmp sockaddr_in %size erase
	PF_INET6 sockaddr-tmp family w!
	htons sockaddr-tmp port w!
	new-socket6
	dup 0< abort" no free socket" >r
	r@ sockaddr-tmp sockaddr_in6 %size bind 0= IF r> exit ENDIF
r> drop true abort" bind :: failed" ;	r> drop true abort" bind :: failed" ;

: create-udp-server ( port# -- lsocket )	: create-udp-server ( port# -- lsocket )
Line 210 $004 Constant POLLOUT	Line 213 $004 Constant POLLOUT
htons sockaddr-tmp port w!	htons sockaddr-tmp port w!
new-udp-socket	new-udp-socket
dup 0< abort" no free socket" >r	dup 0< abort" no free socket" >r
r@ sockaddr-tmp 16 bind 0= IF r> exit ENDIF	r@ sockaddr-tmp sockaddr_in4 %size bind 0= IF r> exit ENDIF
	r> drop true abort" bind :: failed" ;

	: create-udp-server6 ( port# -- lsocket )
	sockaddr-tmp sockaddr_in %size erase
	PF_INET6 sockaddr-tmp family w!
	htons sockaddr-tmp port w!
	new-udp-socket6
	dup 0< abort" no free socket" >r
	r@ sockaddr-tmp sockaddr_in6 %size bind 0= IF r> exit ENDIF
r> drop true abort" bind :: failed" ;	r> drop true abort" bind :: failed" ;

\ from itools.frt	\ from itools.frt

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.40
changed lines
	Added in v.1.41