Annotation of gforth/wordlibs/netlib.fs, revision 1.1

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

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