Patch title: Release 85 bulk changes
Abstract:
File: /pliant/util/network/ping.pli
Key:
    Removed line
    Added line
   
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


function net_ping hostname message timeout -> status
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


function net_ping hostname message timeout -> status
  arg Str hostname ; arg Str message ; arg Float timeout ; a
  arg Str hostname ; arg Str message ; arg Float timeout ; arg ExtendedStatus status
  var Str ip := dns_query_prototype hostname dns_query_funct
  if (ip parse (var Int i1) "." (var Int i2) "." (var Int i3
    var uInt ipaddress := (cast i1 uInt)*256^3 + (cast i2 uI
  else
  var Str ip := dns_query_prototype hostname dns_query_funct
  if (ip parse (var Int i1) "." (var Int i2) "." (var Int i3
    var uInt ipaddress := (cast i1 uInt)*256^3 + (cast i2 uI
  else
    return failure
    return failure:"Failed to parse IP address"
  var Int s := os_socket os_AF_INET os_SOCK_RAW 1
  if s<0
    # not 'root' under Unix, try TCP connection to HTTP port
    (var Stream tcp) open "tcp://"+ip+"/client/80" in+out+sa
  var Int s := os_socket os_AF_INET os_SOCK_RAW 1
  if s<0
    # not 'root' under Unix, try TCP connection to HTTP port
    (var Stream tcp) open "tcp://"+ip+"/client/80" in+out+sa
    return (shunt tcp=success success failure)
    return (shunt tcp=success success failure:"Failed to open TCP port 80")
  
  var Int reserved := 512+message:len
  var Address buf := memory_allocate reserved null
  var Int size := os_icmphdr:size+message:len
  memory_copy message:characters (buf translate os_icmphdr 1


  
  var Int reserved := 512+message:len
  var Address buf := memory_allocate reserved null
  var Int size := os_icmphdr:size+message:len
  memory_copy message:characters (buf translate os_icmphdr 1


  if (os_sendto s buf size 0 addr os_sockaddr_in:size)<>size
  var Int err := os_sendto s buf size 0 addr os_sockaddr_in:size
  if err<>size 
    memory_free buf
    memory_free buf
    return failure
    return (failure "Failed to send ("+string:err+")")

  if verbose
    var DateTime start := datetime
    
  var DateTime start := datetime ; var CBool first := true
  part wait_for_reply
    var Float t := shunt first timeout timeout-(datetime:sec
    if (not first and t<0.001) or (os_socket_wait s 1 t)=fai

  if verbose
    var DateTime start := datetime
    
  var DateTime start := datetime ; var CBool first := true
  part wait_for_reply
    var Float t := shunt first timeout timeout-(datetime:sec
    if (not first and t<0.001) or (os_socket_wait s 1 t)=fai
      status := failure
      status := failure "No reply"
      leave wait_for_reply
    first := false
    var Int len := os_sockaddr_in size
    var Int size := os_recvfrom s buf reserved 0 addr len
    if size<1
      restart wait_for_reply
    var Int hl := (buf map uInt8)%16*4
    if size<hl+os_icmphdr:size
      restart wait_for_reply
    var Pointer:os_icmphdr icp :> (buf translate Byte hl) ma
    if icp:type<>os_ICMP_ECHOREPLY or icp:id<>id or icp:sequ
      restart wait_for_reply
    (var Str answer) set (addressof:icp translate os_icmphdr
      leave wait_for_reply
    first := false
    var Int len := os_sockaddr_in size
    var Int size := os_recvfrom s buf reserved 0 addr len
    if size<1
      restart wait_for_reply
    var Int hl := (buf map uInt8)%16*4
    if size<hl+os_icmphdr:size
      restart wait_for_reply
    var Pointer:os_icmphdr icp :> (buf translate Byte hl) ma
    if icp:type<>os_ICMP_ECHOREPLY or icp:id<>id or icp:sequ
      restart wait_for_reply
    (var Str answer) set (addressof:icp translate os_icmphdr
    status := shunt answer=message success failure
    status := shunt answer=message success failure:"Corrupted answer"


function net_ping hostname -> status


function net_ping hostname -> status
  arg Str hostname ; arg Status status
  arg Str hostname ; arg ExtendedStatus status
  var Str message := "Pliant ping test on "+string:datetime
  for (var Int i) 0 4
    status := net_ping hostname "Pliant ping utility." (min 
    if status=success
      return


export net_ping
  var Str message := "Pliant ping test on "+string:datetime
  for (var Int i) 0 4
    status := net_ping hostname "Pliant ping utility." (min 
    if status=success
      return


export net_ping