Return to socket.fs CVS log

Up to [gforth] / gforth / unix

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

1.1       pazsan      1: \ socket interface
                      2: 
1.11      anton       3: \ Copyright (C) 1998,2000,2003,2005,2006 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
1.9       pazsan     28:            [ELSE]  s" bsd" search nip nip [IF]
                     29:                    library libc libc.so
1.8       pazsan     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: 
1.12    ! anton      62: ' family alias family+port \ 0.6.2 32-bit field; used by itools
        !            63: 
1.1       pazsan     64: Create sockaddr-tmp
                     65: sockaddr-tmp sockaddr_in %size dup allot erase
                     66: 
                     67: : c-string ( addr u -- addr' )
                     68:     tuck pad swap move pad + 0 swap c! pad ;
                     69: 
                     70: : host>addr ( addr u -- x )
                     71:     \G converts a internet name into a IPv4 address
                     72:     \G the resulting address is in network byte order
                     73:     c-string gethostbyname dup 0= abort" address not found"
1.10      pazsan     74:     h_addr_list @ @ @ ntohl ;
1.1       pazsan     75: 
                     76: 2 Constant PF_INET
                     77: 1 Constant SOCK_STREAM
                     78: 6 Constant IPPROTO_TCP
                     79: 
1.8       pazsan     80: : new-socket ( -- socket )
                     81:     PF_INET SOCK_STREAM IPPROTO_TCP socket
                     82:     dup 0<= abort" no free socket" ;
                     83: 
                     84: : >inetaddr ( ip port sockaddr -- ) >r
                     85:     r@ sockaddr_in %size erase
                     86:     PF_INET r@ family w!
                     87:     htons r@ port w!
                     88:     htonl r> sin_addr l! ;
                     89: 
1.1       pazsan     90: : open-socket ( addr u port -- fid )
1.10      pazsan     91:     -rot host>addr
                     92:     swap sockaddr-tmp >inetaddr
1.8       pazsan     93:     new-socket >r
                     94:     r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"
1.1       pazsan     95:     r> s" w+" c-string fdopen ;