\ netlib.fs include netlib.so and forth utilities 08mar98jaw
require ./../wordlib.fs
WordLibrary netlib.fs ./netlib.so
\ ------ Address structures
decimal
struct
char% field sa_len
char% field sa_family
char% 14 * field sa_data
end-struct sockaddr
struct
char% 2* field sin_family
char% 2* field sin_port
char% 4 * field sin_addr
char% 8 * field sin_fill
end-struct sockaddr_in
\ ------ Socket Types and address families
1 constant SOCK_STREAM \ stream (connection) socket
2 constant SOCK_DGRAM \ datagram (conn.less) socket
3 constant SOCK_RAW \ raw socket
4 constant SOCK_RDM \ reliably-delivered message
5 constant SOCK_SEQPACKET \ sequential packet socket
10 constant SOCK_PACKET \ linux specific way of
\ getting packets at the dev
\ level. For writing rarp and
\ other similar things on the
\ user level.
2 constant AF_INET \ just define the most important
\ one
1 constant SOL_SOCKET
\ ------ place +place 01jan95jaw
[IFUNDEF] place
: place ( c-addr1 u c-addr2 )
2dup c! char+ swap move ;
[THEN]
[IFUNDEF] +place
: +place ( adr len adr )
2dup >r >r
dup c@ char+ + swap move
r> r> dup c@ rot + swap c! ;
[THEN]
\ ------ IP number conversion 31dec95jaw
variable ip-class
: (ip>)
2dup [char] . scan
dup >r swap >r -
s>number drop or
r> r>
dup 0= IF EXIT THEN
1 ip-class +!
1- swap 1+ swap ;
: dotted>ip ( adr len -- u )
0 ip-class !
0 -rot 4 0 DO rot 8 lshift -rot (ip>) LOOP
2drop ;
CREATE IP-Num 0 , 30 chars allot align
: ip>dotted ( u -- adr len )
dup 24 rshift
255 and 0 <# [char] . hold #S #> IP-Num place
dup 16 rshift
255 and 0 <# [char] . hold #S #> IP-Num +place
dup 8 rshift
255 and 0 <# [char] . hold #S #> IP-Num +place
255 and 0 <# #S #> IP-Num +place
IP-Num count ;
\ ------ Host and Networkbyteorder 30dec95jaw
\ Shift routines
1 here ! here c@ \ check byte order
[IF] \ little endian
: htonl >r
r@ 255 and 24 lshift
r@ [ 255 8 lshift ] literal and 8 lshift
r@ [ 255 16 lshift ] literal and 8 rshift
r> [ 255 24 lshift ] literal and 24 rshift
or or or ;
: htons >r
r@ 255 and 8 lshift
r> [ 255 8 lshift ] literal and 8 rshift
or ;
' htonl ALIAS ntohl
' htons ALIAS ntohs
[ELSE]
' NOOP ALIAS htonl
' NOOP ALIAS htons
' NOOP ALIAS ntohl
' NOOP ALIAS ntohs
[THEN]
\ ------ Short memory handling 30dec95jaw
1 here ! here c@ \ check byte order
[IF] \ little endian
[IFUNDEF] s@ : s@ ( adr -- s ) @ 65535 and ; [THEN]
[IFUNDEF] s! : s! ( s adr -- ) over 255 and over c!
swap 8 rshift 255 and swap char+ c! ; [THEN]
[ELSE]
[IFUNDEF] s@ : s@ ( adr -- s ) @ 16 rshift ; [THEN]
[IFUNDEF] s! : s! ( s adr -- ) over 8 rshift 255 and over c!
swap 255 and swap char+ c! ; [THEN]
[THEN]
[IFUNDEF] s+! : s+! ( s adr -- ) swap over s@ + swap s! ; [THEN]
\ ------ Utils 08mar98jaw
: uerr
-1 = ;
: hostip ( adr len -- ip )
\G returns the first valid ip address of host with name (adr len)
\G as 32 Bit value in host byte order
net-gethostbyname dup 0= ABORT" can't resolve domain name!"
4 cells + @ ( list address ) @ ( address of address ) @ ( address )
ntohl ;
: connect-tcp ( sockaddr_in* -- sock_fd )
AF_INET SOCK_STREAM 0 net-socket
dup uerr ABORT" couldn't make socket"
>r sockaddr_in %size r@ net-connect uerr ABORT" couldn't connect"
r> ;
: ipport!sockaddr { ip port sockaddr* -- }
port htons sockaddr* sin_port s!
ip htonl sockaddr* sin_addr !
AF_INET sockaddr* sin_family s! ;
: connect-tcp-ip ( ip port -- sock_fd )
sockaddr_in %alloc dup >r ipport!sockaddr
r@ connect-tcp
r> free throw ;
: connect-tcp-name ( adr len port -- sock_fd )
>r hostip r> connect-tcp-ip ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>