basis/io/sockets/unix/unix.factor

   1 ! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types alien.data alien.strings
   4 arrays byte-arrays classes.struct combinators destructors
   5 io.backend.unix io.encodings.ascii io.encodings.utf8 io.files
   6 io.pathnames io.sockets.private kernel libc locals math
   7 namespaces sequences system unix unix.ffi vocabs ;
   8 EXCLUDE: io.sockets => accept ;
   9 IN: io.sockets.unix
  10
  11 : socket-fd ( domain type protocol -- fd )
  12     socket dup io-error <fd> init-fd |dispose ;
  13
  14 : get-socket-option ( fd level opt -- val )
  15     [ handle-fd ] 2dip -1 int <ref> [
  16         dup byte-length int <ref> getsockopt io-error
  17     ] keep int deref ;
  18
  19 : set-socket-option ( fd level opt -- )
  20     [ handle-fd ] 2dip 1 int <ref> dup byte-length setsockopt io-error ;
  21
  22 M: unix addrinfo-error-string
  23     gai_strerror ;
  24
  25 M: unix sockaddr-of-family
  26     {
  27         { AF_INET [ sockaddr-in memory>struct ] }
  28         { AF_INET6 [ sockaddr-in6 memory>struct ] }
  29         { AF_UNIX [ sockaddr-un memory>struct ] }
  30         [ 2drop f ]
  31     } case ;
  32
  33 M: unix addrspec-of-family
  34     {
  35         { AF_INET [ T{ ipv4 } ] }
  36         { AF_INET6 [ T{ ipv6 } ] }
  37         { AF_UNIX [ T{ local } ] }
  38         [ drop f ]
  39     } case ;
  40
  41 ! Client sockets - TCP and Unix domain
  42 M: object (get-local-address)
  43     [ handle-fd ] dip empty-sockaddr/size int <ref>
  44     [ getsockname io-error ] 2keep drop ;
  45
  46 M: object (get-remote-address)
  47     [ handle-fd ] dip empty-sockaddr/size int <ref>
  48     [ getpeername io-error ] 2keep drop ;
  49
  50 : init-client-socket ( fd -- )
  51     SOL_SOCKET SO_OOBINLINE set-socket-option ;
  52
  53 : wait-to-connect ( port -- )
  54     dup +output+ wait-for-port
  55     dup handle>> SOL_SOCKET SO_ERROR get-socket-option
  56     [ drop ] [ (throw-errno) ] if-zero ; inline
  57
  58 M: object establish-connection
  59     2dup
  60     [ handle>> handle-fd ] [ make-sockaddr/size ] bi*
  61     connect 0 = [ 2drop ] [
  62         errno {
  63             { EINTR [ establish-connection ] }
  64             { EINPROGRESS [ drop wait-to-connect ] }
  65             [ (throw-errno) ]
  66         } case
  67     ] if ;
  68
  69 : ?bind-client ( socket -- )
  70     bind-local-address get [
  71         [ fd>> ] dip make-sockaddr/size
  72         [ bind ] unix-system-call drop
  73     ] [
  74         drop
  75     ] if* ; inline
  76
  77 M: object remote>handle
  78     [ protocol-family SOCK_STREAM ] [ protocol ] bi socket-fd
  79     [ init-client-socket ] [ ?bind-client ] [ ] tri ;
  80
  81 ! Server sockets - TCP and Unix domain
  82 : init-server-socket ( fd -- )
  83     SOL_SOCKET SO_REUSEADDR set-socket-option ;
  84
  85 : server-socket-fd ( addrspec type -- fd )
  86     [ dup protocol-family ] dip pick protocol socket-fd
  87     [ init-server-socket ] keep
  88     [ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] keep ;
  89
  90 M: object (server)
  91     [
  92         SOCK_STREAM server-socket-fd
  93         dup handle-fd 128 [ listen ] unix-system-call drop
  94     ] with-destructors ;
  95
  96 : do-accept ( server addrspec -- fd sockaddr )
  97     [ handle>> handle-fd ] [ empty-sockaddr/size int <ref> ] bi*
  98     [ accept ] 2keep drop ; inline
  99
 100 M: object (accept)
 101     2dup do-accept over 0 >= [
 102         [ 2nip <fd> init-fd ] dip
 103     ] [
 104         errno {
 105             { EINTR [ 2drop (accept) ] }
 106             { EAGAIN [
 107                 2drop
 108                 [ drop +input+ wait-for-port ]
 109                 [ (accept) ]
 110                 2bi
 111             ] }
 112             [ (throw-errno) ]
 113         } case
 114     ] if ;
 115
 116 ! Datagram sockets - UDP and Unix domain
 117 M: unix (datagram)
 118     [ SOCK_DGRAM server-socket-fd ] with-destructors ;
 119
 120 M: unix (raw)
 121     [ SOCK_RAW server-socket-fd ] with-destructors ;
 122
 123 M: unix (broadcast)
 124     dup handle>> SOL_SOCKET SO_BROADCAST set-socket-option ;
 125
 126 :: do-receive ( n buf port -- count sockaddr )
 127     port addr>> empty-sockaddr/size :> ( sockaddr len )
 128     port handle>> handle-fd ! s
 129     buf ! buf
 130     n ! nbytes
 131     0 ! flags
 132     sockaddr ! from
 133     len int <ref> ! fromlen
 134     recvfrom sockaddr ; inline
 135
 136 : (receive-loop) ( n buf datagram -- count sockaddr )
 137     3dup do-receive over 0 > [ [ 3drop ] 2dip ] [
 138         2drop [ +input+ wait-for-port ] [ (receive-loop) ] bi
 139     ] if ; inline recursive
 140
 141 M: unix (receive-unsafe)
 142     (receive-loop) ;
 143
 144 :: do-send ( packet sockaddr len socket datagram -- )
 145     socket handle-fd packet dup length 0 sockaddr len sendto
 146     0 < [
 147         errno {
 148             { EINTR [
 149                 packet sockaddr len socket datagram do-send
 150             ] }
 151             { EAGAIN [
 152                 datagram +output+ wait-for-port
 153                 packet sockaddr len socket datagram do-send
 154             ] }
 155             [ (throw-errno) ]
 156         } case
 157     ] when ; inline recursive
 158
 159 M: unix (send)
 160     [ make-sockaddr/size-outgoing ] [ [ handle>> ] keep ] bi* do-send ;
 161
 162 ! Unix domain sockets
 163 M: local protocol-family drop PF_UNIX ;
 164
 165 M: local sockaddr-size drop sockaddr-un heap-size ;
 166
 167 M: local empty-sockaddr drop sockaddr-un <struct> ;
 168
 169 M: local make-sockaddr
 170     path>> absolute-path
 171     dup length 1 + max-un-path > [ "Path too long" throw ] when
 172     sockaddr-un <struct>
 173         AF_UNIX >>family
 174         swap utf8 string>alien >>path ;
 175
 176 M: local parse-sockaddr
 177     drop
 178     path>> utf8 alien>string <local> ;
 179
 180 M: unix host-name
 181     256 [ <byte-array> dup ] keep gethostname io-error
 182     ascii alien>string ;
 183
 184 os linux? [ "io.sockets.unix.linux" require ] when