Powered by ViewCVS 1.0-dev
| 1 : | jwilke | 1.1 | \ netlib.fs include netlib.so and forth utilities 08mar98jaw |
| 2 : | |||
| 3 : | require ./../wordlib.fs | ||
| 4 : | |||
| 5 : | WordLibrary netlib.fs ./netlib.so | ||
| 6 : | |||
| 7 : | \ ------ Address structures | ||
| 8 : | |||
| 9 : | decimal | ||
| 10 : | |||
| 11 : | struct | ||
| 12 : | char% field sa_len | ||
| 13 : | char% field sa_family | ||
| 14 : | char% 14 * field sa_data | ||
| 15 : | end-struct sockaddr | ||
| 16 : | |||
| 17 : | struct | ||
| 18 : | char% 2* field sin_family | ||
| 19 : | char% 2* field sin_port | ||
| 20 : | char% 4 * field sin_addr | ||
| 21 : | char% 8 * field sin_fill | ||
| 22 : | end-struct sockaddr_in | ||
| 23 : | |||
| 24 : | \ ------ Socket Types and address families | ||
| 25 : | |||
| 26 : | 1 constant SOCK_STREAM \ stream (connection) socket | ||
| 27 : | 2 constant SOCK_DGRAM \ datagram (conn.less) socket | ||
| 28 : | 3 constant SOCK_RAW \ raw socket | ||
| 29 : | 4 constant SOCK_RDM \ reliably-delivered message | ||
| 30 : | 5 constant SOCK_SEQPACKET \ sequential packet socket | ||
| 31 : | 10 constant SOCK_PACKET \ linux specific way of | ||
| 32 : | \ getting packets at the dev | ||
| 33 : | \ level. For writing rarp and | ||
| 34 : | \ other similar things on the | ||
| 35 : | \ user level. | ||
| 36 : | |||
| 37 : | 2 constant AF_INET \ just define the most important | ||
| 38 : | \ one | ||
| 39 : | |||
| 40 : | 1 constant SOL_SOCKET | ||
| 41 : | |||
| 42 : | \ ------ place +place 01jan95jaw | ||
| 43 : | |||
| 44 : | [IFUNDEF] place | ||
| 45 : | : place ( c-addr1 u c-addr2 ) | ||
| 46 : | 2dup c! char+ swap move ; | ||
| 47 : | [THEN] | ||
| 48 : | |||
| 49 : | [IFUNDEF] +place | ||
| 50 : | : +place ( adr len adr ) | ||
| 51 : | 2dup >r >r | ||
| 52 : | dup c@ char+ + swap move | ||
| 53 : | r> r> dup c@ rot + swap c! ; | ||
| 54 : | [THEN] | ||
| 55 : | |||
| 56 : | \ ------ IP number conversion 31dec95jaw | ||
| 57 : | |||
| 58 : | variable ip-class | ||
| 59 : | |||
| 60 : | : (ip>) | ||
| 61 : | 2dup [char] . scan | ||
| 62 : | dup >r swap >r - | ||
| 63 : | s>number drop or | ||
| 64 : | r> r> | ||
| 65 : | dup 0= IF EXIT THEN | ||
| 66 : | 1 ip-class +! | ||
| 67 : | 1- swap 1+ swap ; | ||
| 68 : | |||
| 69 : | : dotted>ip ( adr len -- u ) | ||
| 70 : | 0 ip-class ! | ||
| 71 : | 0 -rot 4 0 DO rot 8 lshift -rot (ip>) LOOP | ||
| 72 : | 2drop ; | ||
| 73 : | |||
| 74 : | CREATE IP-Num 0 , 30 chars allot align | ||
| 75 : | |||
| 76 : | : ip>dotted ( u -- adr len ) | ||
| 77 : | dup 24 rshift | ||
| 78 : | 255 and 0 <# [char] . hold #S #> IP-Num place | ||
| 79 : | dup 16 rshift | ||
| 80 : | 255 and 0 <# [char] . hold #S #> IP-Num +place | ||
| 81 : | dup 8 rshift | ||
| 82 : | 255 and 0 <# [char] . hold #S #> IP-Num +place | ||
| 83 : | 255 and 0 <# #S #> IP-Num +place | ||
| 84 : | IP-Num count ; | ||
| 85 : | |||
| 86 : | \ ------ Host and Networkbyteorder 30dec95jaw | ||
| 87 : | \ Shift routines | ||
| 88 : | |||
| 89 : | 1 here ! here c@ \ check byte order | ||
| 90 : | [IF] \ little endian | ||
| 91 : | : htonl >r | ||
| 92 : | r@ 255 and 24 lshift | ||
| 93 : | r@ [ 255 8 lshift ] literal and 8 lshift | ||
| 94 : | r@ [ 255 16 lshift ] literal and 8 rshift | ||
| 95 : | r> [ 255 24 lshift ] literal and 24 rshift | ||
| 96 : | or or or ; | ||
| 97 : | |||
| 98 : | : htons >r | ||
| 99 : | r@ 255 and 8 lshift | ||
| 100 : | r> [ 255 8 lshift ] literal and 8 rshift | ||
| 101 : | or ; | ||
| 102 : | |||
| 103 : | ' htonl ALIAS ntohl | ||
| 104 : | ' htons ALIAS ntohs | ||
| 105 : | [ELSE] | ||
| 106 : | ' NOOP ALIAS htonl | ||
| 107 : | ' NOOP ALIAS htons | ||
| 108 : | ' NOOP ALIAS ntohl | ||
| 109 : | ' NOOP ALIAS ntohs | ||
| 110 : | [THEN] | ||
| 111 : | |||
| 112 : | \ ------ Short memory handling 30dec95jaw | ||
| 113 : | |||
| 114 : | 1 here ! here c@ \ check byte order | ||
| 115 : | [IF] \ little endian | ||
| 116 : | [IFUNDEF] s@ : s@ ( adr -- s ) @ 65535 and ; [THEN] | ||
| 117 : | [IFUNDEF] s! : s! ( s adr -- ) over 255 and over c! | ||
| 118 : | swap 8 rshift 255 and swap char+ c! ; [THEN] | ||
| 119 : | [ELSE] | ||
| 120 : | [IFUNDEF] s@ : s@ ( adr -- s ) @ 16 rshift ; [THEN] | ||
| 121 : | [IFUNDEF] s! : s! ( s adr -- ) over 8 rshift 255 and over c! | ||
| 122 : | swap 255 and swap char+ c! ; [THEN] | ||
| 123 : | [THEN] | ||
| 124 : | [IFUNDEF] s+! : s+! ( s adr -- ) swap over s@ + swap s! ; [THEN] | ||
| 125 : | |||
| 126 : | \ ------ Utils 08mar98jaw | ||
| 127 : | |||
| 128 : | : uerr | ||
| 129 : | -1 = ; | ||
| 130 : | |||
| 131 : | : hostip ( adr len -- ip ) | ||
| 132 : | \G returns the first valid ip address of host with name (adr len) | ||
| 133 : | \G as 32 Bit value in host byte order | ||
| 134 : | net-gethostbyname dup 0= ABORT" can't resolve domain name!" | ||
| 135 : | 4 cells + @ ( list address ) @ ( address of address ) @ ( address ) | ||
| 136 : | ntohl ; | ||
| 137 : | |||
| 138 : | : connect-tcp ( sockaddr_in* -- sock_fd ) | ||
| 139 : | AF_INET SOCK_STREAM 0 net-socket | ||
| 140 : | dup uerr ABORT" couldn't make socket" | ||
| 141 : | >r sockaddr_in %size r@ net-connect uerr ABORT" couldn't connect" | ||
| 142 : | r> ; | ||
| 143 : | |||
| 144 : | : ipport!sockaddr { ip port sockaddr* -- } | ||
| 145 : | port htons sockaddr* sin_port s! | ||
| 146 : | ip htonl sockaddr* sin_addr ! | ||
| 147 : | AF_INET sockaddr* sin_family s! ; | ||
| 148 : | |||
| 149 : | : connect-tcp-ip ( ip port -- sock_fd ) | ||
| 150 : | sockaddr_in %alloc dup >r ipport!sockaddr | ||
| 151 : | r@ connect-tcp | ||
| 152 : | r> free throw ; | ||
| 153 : | |||
| 154 : | : connect-tcp-name ( adr len port -- sock_fd ) | ||
| 155 : | >r hostip r> connect-tcp-ip ; | ||
| 156 : |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |