Annotation of gforth/unix/socket.fs, revision 1.8

1.1       pazsan      1: \ socket interface
                      2: 
1.6       anton       3: \ Copyright (C) 1998,2000,2003,2005 Free Software Foundation, Inc.
1.1       pazsan      4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
                      9: \ as published by the Free Software Foundation; either version 2
                     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
                     18: \ along with this program; if not, write to the Free Software
                     19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
                     20: 
                     21: require lib.fs
1.8     ! pazsan     22: [IFUNDEF] libc
        !            23:     s" os-type" environment? [IF]
        !            24:        2dup s" linux-gnu" str= [IF]  2drop
        !            25:            library libc libc.so.6
        !            26:        [ELSE] 2dup s" cygwin" str= [IF]  2drop
        !            27:                library libc cygwin1.dll
        !            28:            [ELSE]  s" bsd" str= [IF]
        !            29:                    library libc libc.so.5
        !            30:                [THEN]
        !            31:            [THEN]
        !            32:        [THEN]
        !            33:     [THEN]
        !            34: [THEN]
1.1       pazsan     35: 
1.4       pazsan     36: libc gethostbyname ptr (ptr) gethostbyname ( name -- hostent )
                     37: libc socket int int int (int) socket ( class type proto -- fd )
                     38: libc connect int ptr int (int) connect ( fd sock size -- err )
                     39: libc fdopen int ptr (ptr) fdopen ( fd fileattr -- file )
                     40: libc htonl int (int) htonl ( x -- x' )
1.8     ! pazsan     41: libc htons int (int) htons ( x -- x' )
        !            42: libc ntohl int (int) ntohl ( x -- x' )
1.4       pazsan     43: 
                     44: 4 4 2Constant int%
1.8     ! pazsan     45: 2 2 2Constant short%
1.1       pazsan     46: 
                     47: struct
                     48:     cell% field h_name
                     49:     cell% field h_aliases
1.4       pazsan     50:     int% field h_addrtype
                     51:     int% field h_length
1.1       pazsan     52:     cell% field h_addr_list
                     53: end-struct hostent
                     54: 
                     55: struct
1.8     ! pazsan     56:     short% field family
        !            57:     short% field port
1.4       pazsan     58:     int% field sin_addr
1.1       pazsan     59:     cell% 2* field padding
                     60: end-struct sockaddr_in
                     61: 
                     62: Create sockaddr-tmp
                     63: sockaddr-tmp sockaddr_in %size dup allot erase
                     64: 
                     65: : c-string ( addr u -- addr' )
                     66:     tuck pad swap move pad + 0 swap c! pad ;
                     67: 
                     68: : host>addr ( addr u -- x )
                     69:     \G converts a internet name into a IPv4 address
                     70:     \G the resulting address is in network byte order
                     71:     c-string gethostbyname dup 0= abort" address not found"
                     72:     h_addr_list @ @ @ ;
                     73: 
                     74: 2 Constant PF_INET
                     75: 1 Constant SOCK_STREAM
                     76: 6 Constant IPPROTO_TCP
                     77: 
1.8     ! pazsan     78: : new-socket ( -- socket )
        !            79:     PF_INET SOCK_STREAM IPPROTO_TCP socket
        !            80:     dup 0<= abort" no free socket" ;
        !            81: 
        !            82: : >inetaddr ( ip port sockaddr -- ) >r
        !            83:     r@ sockaddr_in %size erase
        !            84:     PF_INET r@ family w!
        !            85:     htons r@ port w!
        !            86:     htonl r> sin_addr l! ;
        !            87: 
1.1       pazsan     88: : open-socket ( addr u port -- fid )
1.8     ! pazsan     89:     -rot host>addr swap sockaddr-tmp >inetaddr
        !            90:     new-socket >r
        !            91:     r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"
1.1       pazsan     92:     r> s" w+" c-string fdopen ;

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