Return to socket.fs CVS log

Up to [gforth] / gforth / unix

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

1.1       pazsan      1: \ socket interface
                      2: 
1.14    ! anton       3: \ Copyright (C) 1998,2000,2003,2005,2006,2007 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.13      pazsan     28:            [ELSE]  2dup s" bsd" search nip nip [IF]  2drop
1.9       pazsan     29:                    library libc libc.so
1.13      pazsan     30:                [ELSE]  2dup s" darwin" string-prefix? [IF]  2drop
                     31:                        library libc libc.dylib
                     32:                    [ELSE]  2drop \ or add your stuff here
                     33:                    [THEN]
1.8       pazsan     34:                [THEN]
                     35:            [THEN]
                     36:        [THEN]
                     37:     [THEN]
                     38: [THEN]
1.1       pazsan     39: 
1.4       pazsan     40: libc gethostbyname ptr (ptr) gethostbyname ( name -- hostent )
                     41: libc socket int int int (int) socket ( class type proto -- fd )
                     42: libc connect int ptr int (int) connect ( fd sock size -- err )
                     43: libc fdopen int ptr (ptr) fdopen ( fd fileattr -- file )
                     44: libc htonl int (int) htonl ( x -- x' )
1.8       pazsan     45: libc htons int (int) htons ( x -- x' )
                     46: libc ntohl int (int) ntohl ( x -- x' )
1.4       pazsan     47: 
                     48: 4 4 2Constant int%
1.8       pazsan     49: 2 2 2Constant short%
1.1       pazsan     50: 
                     51: struct
                     52:     cell% field h_name
                     53:     cell% field h_aliases
1.4       pazsan     54:     int% field h_addrtype
                     55:     int% field h_length
1.1       pazsan     56:     cell% field h_addr_list
                     57: end-struct hostent
                     58: 
                     59: struct
1.8       pazsan     60:     short% field family
                     61:     short% field port
1.4       pazsan     62:     int% field sin_addr
1.1       pazsan     63:     cell% 2* field padding
                     64: end-struct sockaddr_in
                     65: 
1.12      anton      66: ' family alias family+port \ 0.6.2 32-bit field; used by itools
                     67: 
1.1       pazsan     68: Create sockaddr-tmp
                     69: sockaddr-tmp sockaddr_in %size dup allot erase
                     70: 
                     71: : c-string ( addr u -- addr' )
                     72:     tuck pad swap move pad + 0 swap c! pad ;
                     73: 
                     74: : host>addr ( addr u -- x )
                     75:     \G converts a internet name into a IPv4 address
                     76:     \G the resulting address is in network byte order
                     77:     c-string gethostbyname dup 0= abort" address not found"
1.10      pazsan     78:     h_addr_list @ @ @ ntohl ;
1.1       pazsan     79: 
                     80: 2 Constant PF_INET
                     81: 1 Constant SOCK_STREAM
                     82: 6 Constant IPPROTO_TCP
                     83: 
1.8       pazsan     84: : new-socket ( -- socket )
                     85:     PF_INET SOCK_STREAM IPPROTO_TCP socket
                     86:     dup 0<= abort" no free socket" ;
                     87: 
                     88: : >inetaddr ( ip port sockaddr -- ) >r
                     89:     r@ sockaddr_in %size erase
                     90:     PF_INET r@ family w!
                     91:     htons r@ port w!
                     92:     htonl r> sin_addr l! ;
                     93: 
1.1       pazsan     94: : open-socket ( addr u port -- fid )
1.10      pazsan     95:     -rot host>addr
                     96:     swap sockaddr-tmp >inetaddr
1.8       pazsan     97:     new-socket >r
                     98:     r@ sockaddr-tmp sockaddr_in %size connect 0< abort" can't connect"
1.1       pazsan     99:     r> s" w+" c-string fdopen ;