extra/io/sockets/impl/impl.factor

   1 ! Copyright (C) 2007 Doug Coleman, Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays byte-arrays io.backend io.binary io.sockets
   4 kernel math math.parser sequences splitting system
   5 alien.c-types combinators namespaces alien ;
   6 IN: io.sockets.impl
   7
   8 USE-IF: windows? windows.winsock
   9 USE-IF: unix? unix
  10
  11 GENERIC: protocol-family ( addrspec -- af )
  12
  13 GENERIC: sockaddr-type ( addrspec -- type )
  14
  15 GENERIC: make-sockaddr ( addrspec -- sockaddr type )
  16
  17 GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
  18
  19 HOOK: addrinfo-error io-backend ( n -- )
  20
  21 ! IPV4 and IPV6
  22 GENERIC: address-size ( addrspec -- n )
  23
  24 GENERIC: inet-ntop ( data addrspec -- str )
  25
  26 GENERIC: inet-pton ( str addrspec -- data )
  27
  28
  29 M: inet4 inet-ntop ( data addrspec -- str )
  30     drop 4 memory>string [ number>string ] { } map-as "." join ;
  31
  32 M: inet4 inet-pton ( str addrspec -- data )
  33     drop "." split [ string>number ] B{ } map-as ;
  34
  35 M: inet4 address-size drop 4 ;
  36
  37 M: inet4 protocol-family drop PF_INET ;
  38
  39 M: inet4 sockaddr-type drop "sockaddr-in" ;
  40
  41 M: inet4 make-sockaddr ( inet -- sockaddr type )
  42     "sockaddr-in" <c-object>
  43     AF_INET over set-sockaddr-in-family
  44     over inet4-port htons over set-sockaddr-in-port
  45     over inet4-host
  46     "0.0.0.0" or
  47     rot inet-pton *uint over set-sockaddr-in-addr
  48     "sockaddr-in" ;
  49
  50 M: inet4 parse-sockaddr
  51     >r dup sockaddr-in-addr <uint> r> inet-ntop
  52     swap sockaddr-in-port ntohs <inet4> ;
  53
  54
  55 M: inet6 inet-ntop ( data addrspec -- str )
  56     drop 16 memory>string 2 <groups> [ be> >hex ] map ":" join ;
  57
  58 M: inet6 inet-pton ( str addrspec -- data )
  59     drop "::" split1
  60     [ [ ":" split [ hex> dup 0 ? ] map ] [ f ] if* ] 2apply
  61     2dup [ length ] 2apply + 8 swap - 0 <array> swap 3append
  62     [ 2 >be ] map concat >byte-array ;
  63
  64 M: inet6 address-size drop 16 ;
  65
  66 M: inet6 protocol-family drop PF_INET6 ;
  67
  68 M: inet6 sockaddr-type drop "sockaddr-in6" ;
  69
  70 M: inet6 make-sockaddr ( inet -- sockaddr type )
  71     "sockaddr-in6" <c-object>
  72     AF_INET6 over set-sockaddr-in6-family
  73     over inet6-port htons over set-sockaddr-in6-port
  74     over inet6-host "::" or
  75     rot inet-pton over set-sockaddr-in6-addr
  76     "sockaddr-in6" ;
  77
  78 M: inet6 parse-sockaddr
  79     >r dup sockaddr-in6-addr r> inet-ntop
  80     swap sockaddr-in6-port ntohs <inet6> ;
  81
  82 : addrspec-of-family ( af -- addrspec )
  83     {
  84         { [ dup AF_INET = ] [ T{ inet4 } ] }
  85         { [ dup AF_INET6 = ] [ T{ inet6 } ] }
  86         { [ dup AF_UNIX = ] [ T{ local } ] }
  87         { [ t ] [ f ] }
  88     } cond nip ;
  89
  90 M: f parse-sockaddr nip ;
  91
  92 : addrinfo>addrspec ( addrinfo -- addrspec )
  93     dup addrinfo-addr
  94     swap addrinfo-family addrspec-of-family
  95     parse-sockaddr ;
  96
  97 : addrspec, ( addrinfo -- )
  98     [ dup addrinfo>addrspec , addrinfo-next addrspec, ] when* ;
  99
 100 : parse-addrinfo-list ( addrinfo -- seq )
 101     [ addrspec, ] { } make [ ] subset ;
 102
 103 M: object resolve-host ( host serv passive? -- seq )
 104     >r dup integer? [ number>string ] when
 105     "addrinfo" <c-object>
 106     r> [ AI_PASSIVE over set-addrinfo-flags ] when
 107     PF_UNSPEC over set-addrinfo-family
 108     IPPROTO_TCP over set-addrinfo-protocol
 109     f <void*> [ getaddrinfo addrinfo-error ] keep *void*
 110     [ parse-addrinfo-list ] keep
 111     freeaddrinfo ;
 112
 113 M: object host-name ( -- name )
 114     256 <byte-array> dup dup length gethostname
 115     zero? [ "gethostname failed" throw ] unless
 116     alien>char-string ;
 117
 118 : >mac-address ( byte-array -- string )
 119     6 memory>string >byte-array
 120     [ >hex 2 48 pad-left ] { } map-as ":" join ;
 121