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

module "ring.pli"
module "/pliant/language/os/socket.pli"

constant trace false
constant debug false


#----------------------------------------------------------------


constant udp_buffer_size 4096

type UdpStreamDriver
  field Int s
  field Float timeout
  field os_sockaddr_in remote
  field CBool in_done <- false
  field Address in_buffer <- null
  field Address in_cur in_stop
  field CBool out_done <- false
  field Address out_buffer <- null
  field Address out_cur <- null ; field Address out_stop
StreamDriver maybe UdpStreamDriver


method drv read buf mini maxi -> red
  arg_rw UdpStreamDriver drv ; arg Address buf ; arg Int mini maxi red
  if not drv:in_done
    if drv:timeout=defined and (os_socket_wait drv:s in drv:timeout)=failure
      return 0
    var Int size := os_sockaddr_in size
    if maxi>=udp_buffer_size
      red := max (os_recvfrom drv:s buf maxi 0 drv:remote size) 0
      if trace
        console "received " red " bytes" eol
      drv in_cur := null ; drv in_stop := null
      drv in_done := true
      return
    if drv:in_buffer=null
      drv:in_buffer := memory_allocate udp_buffer_size addressof:drv
    drv in_cur := drv in_buffer
    drv in_stop := drv:in_buffer translate Byte (os_recvfrom drv:s drv:in_buffer udp_buffer_size 0 drv:remote size)
    drv in_done := true
  red := min (cast drv:in_stop Int).-.(cast drv:in_cur Int) maxi
  memory_copy drv:in_cur buf red
  drv in_cur := drv:in_cur translate Byte red


method drv write buf mini maxi -> written
  arg_rw UdpStreamDriver drv ; arg Address buf ; arg Int mini maxi written
  if drv:out_buffer=null
    drv:out_buffer := memory_allocate udp_buffer_size addressof:drv
    drv out_cur := drv out_buffer
    drv out_stop := drv:out_buffer translate Byte udp_buffer_size
  written := min (cast drv:out_stop Int).-.(cast drv:out_cur Int) maxi
  memory_copy buf drv:out_cur written
  drv out_cur := drv:out_cur translate Byte written


method drv flush level -> status
  arg_rw UdpStreamDriver drv ; arg Int level ; arg Status status
  if not drv:out_done and drv:out_cur<>drv:out_buffer
    var Int expected := (cast drv:out_cur Int).-.(cast drv:out_buffer Int)
    if trace
      console "sending " expected " bytes" eol
    status := shunt (os_sendto drv:s drv:out_buffer expected 0 drv:remote os_sockaddr_in:size)=expected success failure
    drv out_done := true
  else
    status := success


method drv close -> status
  arg_rw UdpStreamDriver drv ; arg ExtendedStatus status
  if drv:in_buffer<>null
    memory_free drv:in_buffer
  if drv:out_buffer<>null
    memory_free drv:out_buffer
  if trace
    console "closing socket "+(string drv:s)+"[lf]"
  status := shunt (os_close drv:s)=0 success failure


method drv query command stream answer -> status
  arg_rw UdpStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status
  if command="local_ip_address"
    var os_sockaddr_in addr ; var Int addrlen := os_sockaddr_in:size
    if (os_getsockname drv:s addr addrlen)<>0
      return failure
    answer := ip_dot_notation addr:sin_addr
    status := success
  eif command="local_ip_port"
    var os_sockaddr_in addr ; var Int addrlen := os_sockaddr_in:size
    if (os_getsockname drv:s addr addrlen)<>0
      return failure
    answer := 'convert to string' addr:sin_port
    status := success
  eif command="remote_ip_address"
    answer := ip_dot_notation drv:remote:sin_addr
    status := success
  eif command="remote_ip_port"
    answer := 'convert to string' drv:remote:sin_port
    status := success
  eif (command parse word:"timeout" drv:timeout)
    status := success
  else
    status := failure

method drv configure command stream -> status
  oarg_rw UdpStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status
  if command="reset"
    drv flush anytime
    drv in_done := false
    drv out_done := false
    drv out_cur := drv out_buffer
    status := success
  eif (command parse word:"timeout" drv:timeout)
    status := success
  eif (command parse word:"priority" any:(var Str param))
    if os_api="linux"
      var Int tos := shunt param="high" os_IPTOS_LOWDELAY param="low" os_IPTOS_LOWCOST 0
      os_setsockopt drv:s os_IPPROTO_IP os_IP_TOS addressof:tos Int:size
    status := success
  else
    status := failure


#----------------------------------------------------------------


type UdpServerFileSystem
  void
FileSystem maybe UdpServerFileSystem

(gvar Relation connection_sockets) flags := 4
gvar Sem connection_sem


method fs open name options flags stream support -> status
  arg_rw UdpServerFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
  var Int port
  if (name eparse "/server/" port)
    void
  eif (name eparse "/server/any")
    port := 0
  else
    return failure
  stream_lock_handle
  var Int s := os_socket os_AF_INET os_SOCK_DGRAM 0
  stream_unlock_handle s
  if s<0
    if debug
      console "failed to create server socket[lf]"
    connection_sem release
    return failure
  var Int optvalue := 1
  if (os_setsockopt s os_SOL_SOCKET os_SO_REUSEADDR addressof:optvalue Int:size)<>0
    os_close s
    return failure
  var CBool ok := true
  var os_sockaddr_in addr ; var Int addrlen
  addr sin_family := os_AF_INET
  addr sin_addr := 0
  addr sin_port := port
  if ok and (os_bind s addr os_sockaddr_in:size)<>0
    if debug
      console "failed bind server socket[lf]"
    ok := false
  if not ok
    os_close s
    return failure
  var Link:UdpStreamDriver drv :> new UdpStreamDriver
  drv s := s
  drv timeout := undefined
  stream stream_driver :> drv
  stream stream_handle := s
  if trace
    console "opening socket "+(string drv:s)+"[lf]"
  status := success


#----------------------------------------------------------------


type UdpClientFileSystem
  void
FileSystem maybe UdpClientFileSystem


method fs open name options flags stream support -> status
  arg_rw UdpClientFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
  var uInt ipaddress ; var Int port
  if (name eparse "//" (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) "/client/" port) 
    ipaddress := (cast i1 uInt)*256^3 + (cast i2 uInt)*256^2 + (cast i3 uInt)*256 + (cast i4 uInt)
  eif (name eparse "//" any:(var Str hostname) "/client/" port)
    var Str ip := dns_query_prototype hostname dns_query_function
    if (ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4))
      ipaddress := (cast i1 uInt)*256^3 + (cast i2 uInt)*256^2 + (cast i3 uInt)*256 + (cast i4 uInt)
    else
      if debug
        console "failed to get ip address of "+hostname+"[lf]"
      return failure
  eif (name eparse "/client/" port) 
    ipaddress := 127*256^3+1
  else
    if debug
      console "invalid udp client name: "+name+"[lf]"
    return failure
  stream_lock_handle
  var Int s := os_socket os_AF_INET os_SOCK_DGRAM 0
  stream_unlock_handle s
  if s<0
    if debug
      console "failed to create the UDP client socket[lf]"
    return failure
  var Int optvalue := 1
  if (os_setsockopt s os_SOL_SOCKET os_SO_REUSEADDR addressof:optvalue Int:size)<>0
    os_close s
    return failure
  var uInt local_ip
  if ((options (options option_position "local_ip_address" 0) options:len) parse word:"local_ip_address" (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) any)
    local_ip := (cast i1 uInt)*256^3 + (cast i2 uInt)*256^2 + (cast i3 uInt)*256 + (cast i4 uInt)
  else
    local_ip := 0
  var Int local_port := options option "local_ip_port" Int
  if local_ip<>0 or local_port=defined
    var os_sockaddr_in addr ; var Int addrlen
    addr sin_family := os_AF_INET
    addr sin_addr := local_ip
    addr sin_port := local_port
    if (os_bind s addr os_sockaddr_in:size)<>0
      os_close s
      return failure
  var Link:UdpStreamDriver drv :> new UdpStreamDriver
  drv s := s
  drv timeout := undefined
  drv:remote sin_family := os_AF_INET
  drv:remote sin_addr := ipaddress
  drv:remote sin_port := port
  stream stream_driver :> drv
  stream stream_handle := s
  status := success


#----------------------------------------------------------------


gvar UdpClientFileSystem udp_client_file_system
pliant_multi_file_system mount "udp:" "" udp_client_file_system

gvar UdpServerFileSystem udp_server_file_system
pliant_multi_file_system mount "udp:/server/" "/server/" udp_server_file_system