From: Doug Coleman Date: Tue, 21 Sep 2010 16:15:33 +0000 (-0500) Subject: Squashed commit of the following: X-Git-Tag: 0.97~4257^2~85 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=7b0a50e7d20802c1155dd76fe3a02bdaedcfbaf0 Squashed commit of the following: commit 90deaafa9db083ecdb9e0e30ad3694317e616399 Merge: f392dfd 32cf7bb Author: Doug Coleman 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 Date: Fri Sep 10 14:01:47 2010 -0700 ping: Adding a simple IPv4 ping implementation. commit da0c5ce7acf1407256c3ac2b98ac5b68858878c1 Author: John Benediktsson Date: Fri Sep 10 14:01:15 2010 -0700 io.sockets.icmp: Adding ICMP support. commit 60fdf7e7d995d63c11be87e8e1398f7bdd593833 Author: John Benediktsson Date: Fri Sep 10 14:00:48 2010 -0700 io.sockets: Adding protocol support for sockets. commit 2f130f1f9e0e2ea44d798beaad244a9c33b0d86a Author: John Benediktsson Date: Fri Sep 10 14:00:28 2010 -0700 Adding getprotobyname(). --- diff --git a/basis/io/sockets/icmp/authors.txt b/basis/io/sockets/icmp/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/basis/io/sockets/icmp/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/basis/io/sockets/icmp/icmp-docs.factor b/basis/io/sockets/icmp/icmp-docs.factor new file mode 100644 index 0000000000..b06aca98ac --- /dev/null +++ b/basis/io/sockets/icmp/icmp-docs.factor @@ -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 } "." } +{ $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\" " } +} ; + +HELP: +{ $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 } "." +} +{ $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\" " } +} ; + +HELP: +{ $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 } "." +} +{ $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\" " } +} ; + +HELP: +{ $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 + +} +"IPv4 addresses, with no host name resolution:" +{ $subsections + icmp4 + +} +"IPv6 addresses, with no host name resolution:" +{ $subsections + icmp6 + +} ; + +ABOUT: "network-icmp" + diff --git a/basis/io/sockets/icmp/icmp-tests.factor b/basis/io/sockets/icmp/icmp-tests.factor new file mode 100644 index 0000000000..f0f0589dce --- /dev/null +++ b/basis/io/sockets/icmp/icmp-tests.factor @@ -0,0 +1,15 @@ + +USING: accessors destructors kernel io.sockets io.sockets.icmp +sequences tools.test ; + +IN: io.sockets.icmp.tests + +[ { } ] [ + "localhost" resolve-host + [ [ icmp4? ] [ icmp6? ] bi or not ] filter +] unit-test + +[ t ] [ + "127.0.0.1" + [ addr>> icmp4? ] with-disposal +] unit-test diff --git a/basis/io/sockets/icmp/icmp.factor b/basis/io/sockets/icmp/icmp.factor new file mode 100644 index 0000000000..80693c0963 --- /dev/null +++ b/basis/io/sockets/icmp/icmp.factor @@ -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 >> + +> ; + +MEMO: IPPROTO_ICMP6 ( -- protocol ) + "ipv6-icmp" getprotobyname proto>> ; + +GENERIC: with-icmp ( addrspec -- addrspec ) + +PRIVATE> + + +TUPLE: icmp4 < ipv4 ; + +C: icmp4 + +M: ipv4 with-icmp host>> ; + +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 + +M: ipv6 with-icmp host>> ; + +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 + +M: icmp resolve-host call-next-method [ with-icmp ] map ; diff --git a/basis/io/sockets/icmp/summary.txt b/basis/io/sockets/icmp/summary.txt new file mode 100644 index 0000000000..905ff71aa5 --- /dev/null +++ b/basis/io/sockets/icmp/summary.txt @@ -0,0 +1 @@ +Support for ICMP. diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 220587ef1f..7e500eda63 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -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 @@ -194,6 +200,8 @@ M: inet6 parse-sockaddr M: inet6 present [ host>> ] [ port>> number>string ] bi ":" glue ; +M: inet6 protocol drop 0 ; + accept ; IN: io.sockets.unix -: socket-fd ( domain type -- fd ) - 0 socket dup io-error init-fd |dispose ; +: socket-fd ( domain type protocol -- fd ) + socket dup io-error init-fd |dispose ; : set-socket-option ( fd level opt -- ) [ handle-fd ] 2dip 1 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 ; diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor index ade64485db..3114b3aa83 100755 --- a/basis/io/sockets/windows/windows.factor +++ b/basis/io/sockets/windows/windows.factor @@ -41,8 +41,8 @@ M: win32-socket dispose* ( stream -- ) |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 ; diff --git a/basis/unix/ffi/ffi.factor b/basis/unix/ffi/ffi.factor index 5b26cf8deb..56d08b8f7e 100644 --- a/basis/unix/ffi/ffi.factor +++ b/basis/unix/ffi/ffi.factor @@ -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 ) ; diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 99e5e49295..8ed81c972a 100644 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -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 diff --git a/extra/ping/authors.txt b/extra/ping/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/ping/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/ping/ping-tests.factor b/extra/ping/ping-tests.factor new file mode 100644 index 0000000000..8f82ed514c --- /dev/null +++ b/extra/ping/ping-tests.factor @@ -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 diff --git a/extra/ping/ping.factor b/extra/ping/ping.factor new file mode 100644 index 0000000000..07aefca55e --- /dev/null +++ b/extra/ping/ping.factor @@ -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 + + ( 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>byte-array ] 2dip send ; + +: recv-ping ( datagram -- echo ) + receive drop 20 tail byte-array>echo ; + +PRIVATE> + +: ping ( host -- reply ) + resolve-host [ icmp4? ] filter random + f + 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 ; + + diff --git a/extra/ping/summary.txt b/extra/ping/summary.txt new file mode 100644 index 0000000000..f59b1f44b6 --- /dev/null +++ b/extra/ping/summary.txt @@ -0,0 +1 @@ +Uses ICMP to test the reachability of a network host.