Return to netlib.fs CVS log

Up to [gforth] / gforth / netlib

Annotation of gforth/netlib/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: \ ------        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: