extra/ping/ping.factor

   1 ! Copyright (C) 2010 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors byte-arrays calendar checksums
   5 checksums.internet combinators combinators.smart continuations
   6 destructors io.sockets io.sockets.icmp io.timeouts kernel pack
   7 random sequences ;
   8
   9 IN: ping
  10
  11 <PRIVATE
  12
  13 TUPLE: echo type identifier sequence data ;
  14
  15 : <echo> ( sequence data -- echo )
  16     [ 8 16 random-bits ] 2dip echo boa ;
  17
  18 : echo>byte-array ( echo -- byte-array )
  19     [
  20         [
  21             [ type>> 0 0 ] ! code checksum
  22             [ identifier>> ]
  23             [ sequence>> ] tri
  24         ] output>array "CCSSS" pack-be
  25     ] [ data>> ] bi append [
  26         internet checksum-bytes 2 4
  27     ] keep replace-slice ;
  28
  29 : byte-array>echo ( byte-array -- echo )
  30     dup internet checksum-bytes B{ 0 0 } assert=
  31     8 cut [
  32         "CCSSS" unpack-be { 0 3 4 } swap nths first3
  33     ] dip echo boa ;
  34
  35 : send-ping ( addr datagram -- )
  36     [ 0 { } <echo> echo>byte-array ] 2dip send ;
  37
  38 : recv-ping ( datagram -- echo )
  39     receive drop 20 tail byte-array>echo ;
  40
  41 PRIVATE>
  42
  43 : ping ( host -- reply )
  44     <icmp> resolve-host [ icmp4? ] filter random
  45     f <icmp4> <datagram>
  46         1 seconds over set-timeout
  47     [ [ send-ping ] [ recv-ping ] bi ] with-disposal ;
  48
  49 : local-ping ( -- reply )
  50     "127.0.0.1" ping ;
  51
  52 : alive? ( host -- ? )
  53     [ ping drop t ] [ 2drop f ] recover ;
  54
  55