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: