Return to netlib.fs CVS log | Up to [gforth] / gforth / netlib |
Moved netlib stuff to extra directory, because I need a configure script for it.
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: