Squashed commit of the following:
commit 90deaafa9db083ecdb9e0e30ad3694317e616399
Merge: f392dfd 32cf7bb
Author: Doug Coleman <doug.coleman@gmail.com>
Date: Tue Sep 21 00:33:37 2010 -0500
Merge branch 'icmp-ping' of git://github.com/mrjbq7/factor into icmp-ping2
commit 32cf7bb0e0b876309bce248944dfeca243f02594
Author: John Benediktsson <mrjbq7@gmail.com>
Date: Fri Sep 10 14:01:47 2010 -0700
ping: Adding a simple IPv4 ping implementation.
commit da0c5ce7acf1407256c3ac2b98ac5b68858878c1
Author: John Benediktsson <mrjbq7@gmail.com>
Date: Fri Sep 10 14:01:15 2010 -0700
io.sockets.icmp: Adding ICMP support.
commit 60fdf7e7d995d63c11be87e8e1398f7bdd593833
Author: John Benediktsson <mrjbq7@gmail.com>
Date: Fri Sep 10 14:00:48 2010 -0700
io.sockets: Adding protocol support for sockets.
commit 2f130f1f9e0e2ea44d798beaad244a9c33b0d86a
Author: John Benediktsson <mrjbq7@gmail.com>
Date: Fri Sep 10 14:00:28 2010 -0700
Adding getprotobyname().
db4
Doug Coleman
parent
b98f4c13ce
commit
7b0a50e7d2
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
|
||||
USING: help.markup help.syntax io.sockets ;
|
||||
|
||||
IN: io.sockets.icmp
|
||||
|
||||
HELP: icmp
|
||||
{ $class-description
|
||||
"Host name specifier for ICMP. "
|
||||
"The " { $snippet "host" } " slot holds the host name. "
|
||||
"New instances are created by calling " { $link <icmp> } "." }
|
||||
{ $notes
|
||||
"This address specifier can be used with " { $link resolve-host }
|
||||
" to obtain a list of IP addresses associated with the host name, "
|
||||
"and attempts a connection to each one in turn until one succeeds. "
|
||||
"Other network words do not accept this address specifier, and "
|
||||
{ $link resolve-host } " must be called directly; it is "
|
||||
"then up to the application to pick the correct address from the "
|
||||
"(possibly several) addresses associated to the host name."
|
||||
}
|
||||
{ $examples
|
||||
{ $code "\"www.apple.com\" <icmp>" }
|
||||
} ;
|
||||
|
||||
HELP: <icmp>
|
||||
{ $values { "host" "a host name" } { "icmp" icmp } }
|
||||
{ $description "Creates a new " { $link icmp } " address specifier." } ;
|
||||
|
||||
HELP: icmp4
|
||||
{ $class-description
|
||||
"IPv4 address specifier for ICMP. "
|
||||
"The " { $snippet "host" } " slot holds the IPv4 address. "
|
||||
"New instances are created by calling " { $link <icmp4> } "."
|
||||
}
|
||||
{ $notes
|
||||
"Most applications do not operate on IPv4 addresses directly, "
|
||||
"and instead should use the " { $link icmp }
|
||||
" address specifier, or call " { $link resolve-host } "."
|
||||
}
|
||||
{ $examples
|
||||
{ $code "\"127.0.0.1\" <icmp4>" }
|
||||
} ;
|
||||
|
||||
HELP: <icmp4>
|
||||
{ $values { "host" "an IPv4 address" } { "icmp4" icmp4 } }
|
||||
{ $description "Creates a new " { $link icmp4 } " address specifier." } ;
|
||||
|
||||
HELP: icmp6
|
||||
{ $class-description
|
||||
"IPv6 address specifier for ICMP. "
|
||||
"The " { $snippet "host" } " slot holds the IPv6 address. "
|
||||
"New instances are created by calling " { $link <icmp6> } "."
|
||||
}
|
||||
{ $notes
|
||||
"Most applications do not operate on IPv6 addresses directly, "
|
||||
"and instead should use the " { $link icmp }
|
||||
" address specifier, or call " { $link resolve-host } "."
|
||||
}
|
||||
{ $examples
|
||||
{ $code "\"::1\" <icmp6>" }
|
||||
} ;
|
||||
|
||||
HELP: <icmp6>
|
||||
{ $values { "host" "an IPv6 address" } { "icmp6" icmp4 } }
|
||||
{ $description "Creates a new " { $link icmp6 } " address specifier." } ;
|
||||
|
||||
ARTICLE: "network-icmp" "ICMP"
|
||||
"ICMP support is implemented for both IPv4 and IPv6 addresses, using the "
|
||||
"operating system's host name resolution (via " { $link resolve-host } "):"
|
||||
{ $subsections
|
||||
icmp
|
||||
<icmp>
|
||||
}
|
||||
"IPv4 addresses, with no host name resolution:"
|
||||
{ $subsections
|
||||
icmp4
|
||||
<icmp4>
|
||||
}
|
||||
"IPv6 addresses, with no host name resolution:"
|
||||
{ $subsections
|
||||
icmp6
|
||||
<icmp6>
|
||||
} ;
|
||||
|
||||
ABOUT: "network-icmp"
|
||||
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
USING: accessors destructors kernel io.sockets io.sockets.icmp
|
||||
sequences tools.test ;
|
||||
|
||||
IN: io.sockets.icmp.tests
|
||||
|
||||
[ { } ] [
|
||||
"localhost" <icmp> resolve-host
|
||||
[ [ icmp4? ] [ icmp6? ] bi or not ] filter
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"127.0.0.1" <icmp4> <datagram>
|
||||
[ addr>> icmp4? ] with-disposal
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
! Copyright (C) 2010 John Benediktsson
|
||||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: accessors arrays combinators generic kernel io.sockets
|
||||
io.sockets.private memoize sequences system vocabs.parser ;
|
||||
|
||||
IN: io.sockets.icmp
|
||||
|
||||
<< {
|
||||
{ [ os windows? ] [ "windows.winsock" ] }
|
||||
{ [ os unix? ] [ "unix.ffi" ] }
|
||||
} cond use-vocab >>
|
||||
|
||||
<PRIVATE
|
||||
|
||||
MEMO: IPPROTO_ICMP4 ( -- protocol )
|
||||
"icmp" getprotobyname proto>> ;
|
||||
|
||||
MEMO: IPPROTO_ICMP6 ( -- protocol )
|
||||
"ipv6-icmp" getprotobyname proto>> ;
|
||||
|
||||
GENERIC: with-icmp ( addrspec -- addrspec )
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
||||
TUPLE: icmp4 < ipv4 ;
|
||||
|
||||
C: <icmp4> icmp4
|
||||
|
||||
M: ipv4 with-icmp host>> <icmp4> ;
|
||||
|
||||
M: icmp4 protocol drop IPPROTO_ICMP4 ;
|
||||
|
||||
M: icmp4 port>> drop 0 ;
|
||||
|
||||
M: icmp4 parse-sockaddr call-next-method with-icmp ;
|
||||
|
||||
M: icmp4 resolve-host 1array ;
|
||||
|
||||
|
||||
TUPLE: icmp6 < ipv6 ;
|
||||
|
||||
C: <icmp6> icmp6
|
||||
|
||||
M: ipv6 with-icmp host>> <icmp6> ;
|
||||
|
||||
M: icmp6 protocol drop IPPROTO_ICMP6 ;
|
||||
|
||||
M: icmp6 port>> drop 0 ;
|
||||
|
||||
M: icmp6 parse-sockaddr call-next-method with-icmp ;
|
||||
|
||||
M: icmp6 resolve-host 1array ;
|
||||
|
||||
|
||||
TUPLE: icmp < hostname ;
|
||||
|
||||
C: <icmp> icmp
|
||||
|
||||
M: icmp resolve-host call-next-method [ with-icmp ] map ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Support for ICMP.
|
||||
|
|
@ -19,6 +19,8 @@ IN: io.sockets
|
|||
|
||||
UNION: ?string string POSTPONE: f ;
|
||||
|
||||
GENERIC: protocol ( addrspec -- n )
|
||||
|
||||
GENERIC: protocol-family ( addrspec -- af )
|
||||
|
||||
GENERIC: sockaddr-size ( addrspec -- n )
|
||||
|
|
@ -58,6 +60,8 @@ TUPLE: local { path read-only } ;
|
|||
|
||||
M: local present path>> "Unix domain socket: " prepend ;
|
||||
|
||||
M: local protocol drop 0 ;
|
||||
|
||||
SLOT: port
|
||||
|
||||
TUPLE: ipv4 { host ?string read-only } ;
|
||||
|
|
@ -117,6 +121,8 @@ M: inet4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
|
|||
M: inet4 present
|
||||
[ host>> ] [ port>> number>string ] bi ":" glue ;
|
||||
|
||||
M: inet4 protocol drop 0 ;
|
||||
|
||||
TUPLE: ipv6 { host ?string read-only } ;
|
||||
|
||||
C: <ipv6> ipv6
|
||||
|
|
@ -194,6 +200,8 @@ M: inet6 parse-sockaddr
|
|||
M: inet6 present
|
||||
[ host>> ] [ port>> number>string ] bi ":" glue ;
|
||||
|
||||
M: inet6 protocol drop 0 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: (get-local-address) ( handle remote -- sockaddr )
|
||||
|
|
|
|||
|
|
@ -13,8 +13,8 @@ EXCLUDE: io.sockets => accept ;
|
|||
|
||||
IN: io.sockets.unix
|
||||
|
||||
: socket-fd ( domain type -- fd )
|
||||
0 socket dup io-error <fd> init-fd |dispose ;
|
||||
: socket-fd ( domain type protocol -- fd )
|
||||
socket dup io-error <fd> init-fd |dispose ;
|
||||
|
||||
: set-socket-option ( fd level opt -- )
|
||||
[ handle-fd ] 2dip 1 <int> dup byte-length setsockopt io-error ;
|
||||
|
|
@ -83,7 +83,7 @@ M:: object establish-connection ( client-out remote -- )
|
|||
] if* ; inline
|
||||
|
||||
M: object ((client)) ( addrspec -- fd )
|
||||
protocol-family SOCK_STREAM socket-fd
|
||||
[ protocol-family SOCK_STREAM ] [ protocol ] bi socket-fd
|
||||
[ init-client-socket ] [ ?bind-client ] [ ] tri ;
|
||||
|
||||
! Server sockets - TCP and Unix domain
|
||||
|
|
@ -91,7 +91,7 @@ M: object ((client)) ( addrspec -- fd )
|
|||
SOL_SOCKET SO_REUSEADDR set-socket-option ;
|
||||
|
||||
: server-socket-fd ( addrspec type -- fd )
|
||||
[ dup protocol-family ] dip socket-fd
|
||||
[ dup protocol-family ] dip pick protocol socket-fd
|
||||
[ init-server-socket ] keep
|
||||
[ handle-fd swap make-sockaddr/size [ bind ] unix-system-call drop ] keep ;
|
||||
|
||||
|
|
|
|||
|
|
@ -41,8 +41,8 @@ M: win32-socket dispose* ( stream -- )
|
|||
<win32-socket> |dispose add-completion ;
|
||||
|
||||
: open-socket ( addrspec type -- win32-socket )
|
||||
[ protocol-family ] dip
|
||||
0 f 0 WSASocket-flags WSASocket
|
||||
[ drop protocol-family ] [ swap protocol ] 2bi
|
||||
f 0 WSASocket-flags WSASocket
|
||||
dup socket-error
|
||||
opened-socket ;
|
||||
|
||||
|
|
|
|||
|
|
@ -52,6 +52,11 @@ STRUCT: group
|
|||
{ gr_gid int }
|
||||
{ gr_mem c-string* } ;
|
||||
|
||||
STRUCT: protoent
|
||||
{ name c-string }
|
||||
{ aliases void* }
|
||||
{ proto int } ;
|
||||
|
||||
FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
|
||||
FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
|
||||
FUNCTION: int chdir ( c-string path ) ;
|
||||
|
|
@ -100,6 +105,7 @@ FUNCTION: void endgrent ( ) ;
|
|||
FUNCTION: int gethostname ( c-string name, int len ) ;
|
||||
FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ;
|
||||
FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ;
|
||||
FUNCTION: protoent* getprotobyname ( c-string name ) ;
|
||||
FUNCTION: uid_t getuid ;
|
||||
FUNCTION: uint htonl ( uint n ) ;
|
||||
FUNCTION: ushort htons ( ushort n ) ;
|
||||
|
|
|
|||
|
|
@ -126,6 +126,11 @@ STRUCT: hostent
|
|||
{ length short }
|
||||
{ addr-list void* } ;
|
||||
|
||||
STRUCT: protoent
|
||||
{ name c-string }
|
||||
{ aliases void* }
|
||||
{ proto short } ;
|
||||
|
||||
STRUCT: addrinfo
|
||||
{ flags int }
|
||||
{ family int }
|
||||
|
|
@ -171,6 +176,8 @@ FUNCTION: int recv ( SOCKET s, c-string buf, int len, int flags ) ;
|
|||
FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
|
||||
FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
|
||||
|
||||
FUNCTION: protoent* getprotobyname ( c-string name ) ;
|
||||
|
||||
TYPEDEF: uint SERVICETYPE
|
||||
TYPEDEF: OVERLAPPED WSAOVERLAPPED
|
||||
TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
John Benediktsson
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
|
||||
USING: ping tools.test ;
|
||||
|
||||
IN: ping.tests
|
||||
|
||||
[ t ] [ "localhost" alive? ] unit-test
|
||||
[ t ] [ "127.0.0.1" alive? ] unit-test
|
||||
[ f ] [ "0.0.0.0" alive? ] unit-test
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
! 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 ;
|
||||
|
||||
IN: ping
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: echo type identifier sequence data ;
|
||||
|
||||
: <echo> ( sequence data -- echo )
|
||||
[ 8 16 random-bits ] 2dip echo boa ;
|
||||
|
||||
: echo>byte-array ( echo -- byte-array )
|
||||
[
|
||||
[
|
||||
[ type>> 0 0 ] ! code checksum
|
||||
[ identifier>> ]
|
||||
[ sequence>> ] tri
|
||||
] output>array "CCSSS" pack-be
|
||||
] [ data>> ] bi append [
|
||||
internet checksum-bytes 2 4
|
||||
] keep replace-slice ;
|
||||
|
||||
: byte-array>echo ( byte-array -- echo )
|
||||
dup internet checksum-bytes B{ 0 0 } assert=
|
||||
8 cut [
|
||||
"CCSSS" unpack-be { 0 3 4 } swap nths first3
|
||||
] dip echo boa ;
|
||||
|
||||
: send-ping ( addr datagram -- )
|
||||
[ 0 { } <echo> echo>byte-array ] 2dip send ;
|
||||
|
||||
: recv-ping ( datagram -- echo )
|
||||
receive drop 20 tail byte-array>echo ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: ping ( host -- reply )
|
||||
<icmp> resolve-host [ icmp4? ] filter random
|
||||
f <icmp4> <datagram>
|
||||
1 seconds over set-timeout
|
||||
[ [ send-ping ] [ recv-ping ] bi ] with-disposal ;
|
||||
|
||||
: local-ping ( -- reply )
|
||||
"127.0.0.1" ping ;
|
||||
|
||||
: alive? ( host -- ? )
|
||||
[ ping drop t ] [ 2drop f ] recover ;
|
||||
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
Uses ICMP to test the reachability of a network host.
|
||||
Loading…
Reference in New Issue