From e4347f5254f6e03b92a312baaf66d35e6438579b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 19 Feb 2016 18:58:43 -0800 Subject: [PATCH] io.sockets: Add more utility words for working with udp. --- basis/io/sockets/sockets-docs.factor | 71 +++++++++++++++++++++- basis/io/sockets/sockets.factor | 40 ++++++++++-- extra/benchmark/tcp-echo0/tcp-echo0.factor | 2 +- extra/dns/dns.factor | 6 +- extra/ntp/ntp.factor | 6 +- extra/wake-on-lan/wake-on-lan.factor | 4 +- 6 files changed, 113 insertions(+), 16 deletions(-) diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor index d40991991b..7e3ec264e9 100644 --- a/basis/io/sockets/sockets-docs.factor +++ b/basis/io/sockets/sockets-docs.factor @@ -216,15 +216,82 @@ HELP: { $errors "Throws an error if the port is already in use, or if the OS forbids access." } ; HELP: receive -{ $values { "datagram" "a datagram socket" } { "packet" byte-array } { "addrspec" "an address specifier" } } +{ $values { "datagram" "a datagram socket" } { "bytes" byte-array } { "addrspec" "an address specifier" } } { $description "Waits for an incoming packet on the given datagram socket. Outputs the packet data, as well as the sender's address." } { $errors "Throws an error if the packet could not be received." } ; HELP: send -{ $values { "packet" byte-array } { "addrspec" "an address specifier" } { "datagram" "a datagram socket" } } +{ $values { "bytes" byte-array } { "addrspec" "an address specifier" } { "datagram" "a datagram socket" } } { $description "Sends a packet to the given address." } { $errors "Throws an error if the packet could not be sent." } ; +HELP: send-once +{ $values + { "bytes" byte-array } { "addrspec" "an address specifier" } +} +{ $examples + "Send a datagram to localhost, port 7777:" + { $example "USING: io.sockets prettyprint ;" + "B{ 1 2 3 } f 7777 send-once" + "" + } +} +{ $description "Sends a packet one time to the address and closes the sending datagram port." } ; + +HELP: send-n-times +{ $values + { "bytes" byte-array } { "addrspec" "an address specifier" } { "n" integer } +} +{ $examples + "Send a datagram 10 times to localhost, port 7777:" + { $example "USING: io.sockets prettyprint ;" + "B{ 1 2 3 } f 7777 10 send-n-times" + "" + } +} +{ $description "Sends a packet n times to the address and closes the sending datagram port." } ; + +HELP: broadcast-once +{ $values + { "bytes" byte-array } { "addrspec" "an address specifier" } +} +{ $examples + "Send a datagram to localhost, port 7777:" + { $example "USING: io.sockets prettyprint ;" + "B{ 1 2 3 } f 7777 broadcast-once" + "" + } +} +{ $description "Broadcasts a packet one time to the address and closes the sending broadcast port." } ; + +HELP: broadcast-n-times +{ $values + { "bytes" byte-array } { "addrspec" "an address specifier" } { "n" integer } +} +{ $examples + "Broadcast a datagram 10 times to localhost, port 7777:" + { $example "USING: io.sockets prettyprint ;" + "B{ 1 2 3 } f 7777 10 broadcast-n-times" + "" + } +} +{ $description "Broadcasts a packet n times to the address and closes the sending broadcast port." } ; + + + +HELP: with-random-local-broadcast +{ $values + { "quot" quotation } +} +{ $description "Creates a broadcast datagram socket and calls the quotation with this datagram on top of the stack, cleaning up afterwards." } ; + +HELP: with-random-local-datagram +{ $values + { "quot" quotation } +} +{ $description "Creates a datagram socket and calls the quotation with this datagram on top of the stack, cleaning up afterwards." } ; + + HELP: resolve-host { $values { "addrspec" "an address specifier" } { "seq" "a sequence of address specifiers" } } { $description "Resolves host names to IP addresses." } diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index ff01ecf037..e786ad0bc9 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -119,6 +119,8 @@ TUPLE: inet4 < ipv4 { port integer read-only } ; : ( host port -- inet4 ) over check-ipv4 inet4 boa ; +: ( -- inet4 ) f 0 ; + M: ipv4 with-port [ host>> ] dip ; M: inet4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec ) @@ -288,20 +290,20 @@ HOOK: (receive-unsafe) io-backend ( n buf datagram -- count addrspec ) ERROR: invalid-port object ; -: check-port ( packet addrspec port -- packet addrspec port ) +: check-port ( bytes addrspec port -- bytes addrspec port ) 2dup addr>> [ class-of ] bi@ assert= pick class-of 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-send ( bytes addrspec port -- bytes addrspec port ) check-connectionless-port check-disposed check-port ; : check-receive ( port -- port ) check-connectionless-port check-disposed ; -HOOK: (send) io-backend ( packet addrspec datagram -- ) +HOOK: (send) io-backend ( bytes addrspec datagram -- ) : addrinfo>addrspec ( addrinfo -- addrspec ) [ [ addr>> ] [ family>> ] bi sockaddr-of-family ] @@ -375,7 +377,7 @@ SYMBOL: remote-address CONSTANT: datagram-size 65536 -:: receive ( datagram -- packet addrspec ) +:: receive ( datagram -- bytes addrspec ) datagram-size (byte-array) :> buf datagram-size buf datagram receive-unsafe :> ( count addrspec ) @@ -386,9 +388,37 @@ CONSTANT: datagram-size 65536 n buf datagram receive-unsafe :> ( count addrspec ) buf count head-slice addrspec ; inline -: send ( packet addrspec datagram -- ) +: send ( bytes addrspec datagram -- ) check-send (send) ; inline +: ( -- datagram ) + ; + +: ( -- datagram ) + ; + +: with-random-local-datagram ( quot -- ) + [ ] dip with-disposal ; inline + +: with-random-local-broadcast ( quot -- ) + [ ] dip with-disposal ; inline + +: send-once ( bytes addrspec -- ) + [ send ] with-random-local-datagram ; + +:: send-n-times ( bytes addrspec n -- ) + [ + n swap '[ bytes addrspec _ send ] times + ] with-random-local-datagram ; + +: broadcast-once ( bytes addrspec -- ) + [ send ] with-random-local-broadcast ; + +:: broadcast-n-times ( bytes addrspec n -- ) + [ + n swap '[ bytes addrspec _ send ] times + ] with-random-local-broadcast ; + MEMO: ipv6-supported? ( -- ? ) [ "::1" 0 binary dispose t ] [ drop f ] recover ; diff --git a/extra/benchmark/tcp-echo0/tcp-echo0.factor b/extra/benchmark/tcp-echo0/tcp-echo0.factor index 60500b3aa8..c2bf0c03ff 100644 --- a/extra/benchmark/tcp-echo0/tcp-echo0.factor +++ b/extra/benchmark/tcp-echo0/tcp-echo0.factor @@ -16,7 +16,7 @@ TUPLE: tcp-echo < threaded-server #times #bytes ; binary \ tcp-echo new-threaded-server swap >>#bytes swap >>#times - f 0 >>insecure ; + >>insecure ; ERROR: incorrect-#bytes ; diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index d8e3f6bdf7..011949a37b 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -325,10 +325,10 @@ M: TXT rdata>byte-array ] B{ } append-outputs-as ; : udp-query ( bytes server -- bytes' ) - f 0 - 10 seconds over set-timeout [ + [ + 10 seconds over set-timeout [ send ] [ receive drop ] bi - ] with-disposal ; + ] with-random-local-datagram ; : ( -- inet4 ) dns-servers get random 53 ; diff --git a/extra/ntp/ntp.factor b/extra/ntp/ntp.factor index eab1d79486..ec42762a70 100644 --- a/extra/ntp/ntp.factor +++ b/extra/ntp/ntp.factor @@ -103,10 +103,10 @@ PRIVATE> ! - why does resolve-host not work? : ( host -- ntp ) - 123 resolve-host [ inet4? ] filter random - f 0 [ + 123 resolve-host + [ inet4? ] filter random [ [ REQUEST ] 2dip [ send ] [ receive drop ] bi (ntp) - ] with-disposal ; + ] with-random-local-datagram ; : default-ntp ( -- ntp ) "pool.ntp.org" ; diff --git a/extra/wake-on-lan/wake-on-lan.factor b/extra/wake-on-lan/wake-on-lan.factor index 43082904d0..fb04153deb 100644 --- a/extra/wake-on-lan/wake-on-lan.factor +++ b/extra/wake-on-lan/wake-on-lan.factor @@ -11,7 +11,7 @@ IN: wake-on-lan : mac-address-bytes ( mac-address -- byte-array ) ":-" split [ hex> ] B{ } map-as ; -: wake-on-lan-packet ( mac-address -- bytearray ) +: wake-on-lan-packet ( mac-address -- byte-array ) [ 16 ] [ mac-address-bytes ] bi* concat B{ 0xff 0xff 0xff 0xff 0xff 0xff } prepend ; @@ -19,4 +19,4 @@ PRIVATE> : wake-on-lan ( mac-address broadcast-ip -- ) [ wake-on-lan-packet ] [ 9 ] bi* - f 0 [ send ] with-disposal ; + broadcast-once ;