Implement a raw port. Make ping only run on Windows and Mac because the other platforms require root privs.

basis/io/sockets/sockets.factor

@@ -1,12 +1,13 @@
 ! Copyright (C) 2007, 2010 Slava Pestov, Doug Coleman,
 ! Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: generic kernel io.backend namespaces continuations sequences
-arrays io.encodings io.ports io.streams.duplex io.encodings.ascii
-alien.strings io.binary accessors destructors classes byte-arrays
-parser alien.c-types math.parser splitting grouping math assocs
-summary system vocabs.loader combinators present fry vocabs.parser
-classes.struct alien.data strings io.encodings.binary ;
+USING: accessors alien.c-types alien.data alien.strings arrays
+assocs byte-arrays classes classes.struct combinators
+combinators.short-circuit continuations destructors fry generic
+grouping io.backend io.binary io.encodings io.encodings.ascii
+io.encodings.binary io.ports io.streams.duplex kernel math
+math.parser namespaces parser present sequences splitting
+strings summary system vocabs.loader vocabs.parser ;
 IN: io.sockets
 
 << {
@@ -254,17 +255,28 @@ TUPLE: datagram-port < port addr ;
 
 HOOK: (datagram) io-backend ( addr -- datagram )
 
-: check-datagram-port ( port -- port )
-    dup check-disposed
-    dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
+
+TUPLE: raw-port < port addr ;
+
+HOOK: (raw) io-backend ( addr -- raw )
 
 HOOK: (receive) io-backend ( datagram -- packet addrspec )
 
-: check-datagram-send ( packet addrspec port -- packet addrspec port )
-    check-datagram-port
+ERROR: invalid-port object ;
+
+: check-port ( packet addrspec port -- packet addrspec port )
     2dup addr>> [ class ] bi@ assert=
     pick class byte-array assert= ;
 
+: check-connectionless-port ( port -- port )
+    dup { [ datagram-port? ] [ raw-port? ] } 1|| [ invalid-port ] unless ;
+    
+: check-send ( packet addrspec port -- packet addrspec port )
+    check-connectionless-port dup check-disposed check-port ;
+    
+: check-receive ( port -- port )
+    check-connectionless-port dup check-disposed ;
+    
 HOOK: (send) io-backend ( packet addrspec datagram -- )
 
 : addrinfo>addrspec ( addrinfo -- addrspec )
@@ -323,12 +335,19 @@ SYMBOL: remote-address
         >>addr
     ] with-destructors ;
 
+: <raw> ( addrspec -- datagram )
+    [
+        [ (raw) |dispose ] keep
+        [ drop raw-port <port> ] [ get-local-address ] 2bi
+        >>addr
+    ] with-destructors ;
+
 : receive ( datagram -- packet addrspec )
-    check-datagram-port
+    check-receive
     [ (receive) ] [ addr>> ] bi parse-sockaddr ;
 
 : send ( packet addrspec datagram -- )
-    check-datagram-send (send) ;
+    check-send (send) ;
 
 GENERIC: resolve-host ( addrspec -- seq )
 

basis/io/sockets/unix/unix.factor

@@ -123,6 +123,9 @@ M: object (accept) ( server addrspec -- fd sockaddr )
 M: unix (datagram)
     [ SOCK_DGRAM server-socket-fd ] with-destructors ;
 
+M: unix (raw)
+    [ SOCK_RAW server-socket-fd ] with-destructors ;
+
 SYMBOL: receive-buffer
 
 CONSTANT: packet-size 65536

basis/io/sockets/windows/windows.factor

@@ -80,19 +80,11 @@ M: object (server) ( addrspec -- handle )
         dup handle>> listen-backlog listen winsock-return-check
     ] with-destructors ;
 
-GENERIC: windows-socket-type ( obj -- n )
-
-M: inet4 windows-socket-type drop SOCK_DGRAM ;
-
-M: inet6 windows-socket-type drop SOCK_DGRAM ;
-
-M: icmp4 windows-socket-type drop SOCK_RAW ;
-
-M: icmp6 windows-socket-type drop SOCK_RAW ;
-    
 M: windows (datagram) ( addrspec -- handle )
-    [ dup windows-socket-type server-socket ] with-destructors ;
+    [ SOCK_DGRAM server-socket ] with-destructors ;
 
+M: windows (raw) ( addrspec -- handle )
+    [ SOCK_RAW server-socket ] with-destructors ;
 
 : malloc-int ( n -- alien )
     <int> malloc-byte-array ; inline

basis/unix/ffi/bsd/bsd.factor

@@ -64,6 +64,7 @@ CONSTANT: max-un-path 104
 
 CONSTANT: SOCK_STREAM 1
 CONSTANT: SOCK_DGRAM 2
+CONSTANT: SOCK_RAW 3
 
 CONSTANT: AF_UNSPEC 0
 CONSTANT: AF_UNIX 1

basis/unix/ffi/linux/linux.factor

@@ -62,6 +62,7 @@ STRUCT: sockaddr-un
 
 CONSTANT: SOCK_STREAM 1
 CONSTANT: SOCK_DGRAM 2
+CONSTANT: SOCK_RAW 3
 
 CONSTANT: AF_UNSPEC 0
 CONSTANT: AF_UNIX 1

extra/ping/ping-tests.factor

@@ -1,6 +1,5 @@
-
-USING: ping tools.test ;
-
+USING: continuations destructors io.sockets kernel ping
+tools.test ;
 IN: ping.tests
 
 [ t ] [ "localhost" alive? ] unit-test

extra/ping/ping.factor

@@ -1,11 +1,9 @@
 ! Copyright (C) 2010 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
-
 USING: accessors byte-arrays calendar checksums
 checksums.internet combinators combinators.smart continuations
-destructors io.sockets io.sockets.icmp io.timeouts kernel pack
-random sequences locals ;
-
+destructors io.sockets io.sockets.icmp io.timeouts kernel
+locals pack random sequences system ;
 IN: ping
 
 <PRIVATE
@@ -32,21 +30,27 @@ TUPLE: echo type identifier sequence data ;
         "CCSSS" unpack-be { 0 3 4 } swap nths first3
     ] dip echo boa ;
 
-: send-ping ( addr datagram -- )
+: send-ping ( addr raw -- )
     [ 0 { } <echo> echo>byte-array ] 2dip send ;
 
-:: recv-ping ( addr datagram -- echo )
-    datagram receive addr = [
+:: recv-ping ( addr raw -- echo )
+    raw receive addr = [
         20 tail byte-array>echo
     ] [
-        drop addr datagram recv-ping
+        drop addr raw recv-ping
     ] if ;
 
 PRIVATE>
 
+HOOK: <ping-port> os ( inet -- port )
+
+M: object <ping-port> <raw> ;
+
+M: macosx <ping-port> <datagram> ;
+
 : ping ( host -- reply )
     <icmp> resolve-host [ icmp4? ] filter random
-    f <icmp4> <datagram>
+    f <icmp4> <ping-port>
         1 seconds over set-timeout
     [ [ send-ping ] [ recv-ping ] 2bi ] with-disposal ;
 

extra/ping/platforms.txt

@@ -0,0 +1 @@
+windows macosx