/pliant/language/stream/udp.pli
 
 1  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 2  # 
 3  # This program is free software; you can redistribute it and/or 
 4  # modify it under the terms of the GNU General Public License version 2 
 5  # as published by the Free Software Foundation. 
 6  # 
 7  # This program is distributed in the hope that it will be useful, 
 8  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 9  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 10  # GNU General Public License for more details. 
 11  # 
 12  # You should have received a copy of the GNU General Public License 
 13  # version 2 along with this program; if not, write to the Free Software 
 14  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 15   
 16  module "ring.pli" 
 17  module "/pliant/language/os/socket.pli" 
 18   
 19  constant trace false 
 20  constant debug false 
 21   
 22   
 23 
 
 24   
 25   
 26  constant udp_buffer_size 4096 
 27   
 28  type UdpStreamDriver 
 29    field Int s 
 30    field Float timeout 
 31    field os_sockaddr_in remote 
 32    field CBool in_done <- false 
 33    field Address in_buffer <- null 
 34    field Address in_cur in_stop 
 35    field CBool out_done <- false 
 36    field Address out_buffer <- null 
 37    field Address out_cur <- null ; field Address out_stop 
 38  StreamDriver maybe UdpStreamDriver 
 39   
 40   
 41  method drv read buf mini maxi -> red 
 42    arg_rw UdpStreamDriver drv ; arg Address buf ; arg Int mini maxi red 
 43    if not drv:in_done 
 44      if drv:timeout=defined and (os_socket_wait drv:in drv:timeout)=failure 
 45        return 0 
 46      var Int size := os_sockaddr_in size 
 47      if maxi>=udp_buffer_size 
 48        red := max (os_recvfrom drv:buf maxi drv:remote size) 0 
 49        if trace 
 50          console "received " red " bytes" eol 
 51        drv in_cur := null ; drv in_stop := null 
 52        drv in_done := true 
 53        return 
 54      if drv:in_buffer=null 
 55        drv:in_buffer := memory_allocate udp_buffer_size addressof:drv 
 56      drv in_cur := drv in_buffer 
 57      drv in_stop := drv:in_buffer translate Byte (os_recvfrom drv:drv:in_buffer udp_buffer_size 0 drv:remote size) 
 58      drv in_done := true 
 59    red := min (cast drv:in_stop Int).-.(cast drv:in_cur Int) maxi 
 60    memory_copy drv:in_cur buf red 
 61    drv in_cur := drv:in_cur translate Byte red 
 62   
 63   
 64  method drv write buf mini maxi -> written 
 65    arg_rw UdpStreamDriver drv ; arg Address buf ; arg Int mini maxi written 
 66    if drv:out_buffer=null 
 67      drv:out_buffer := memory_allocate udp_buffer_size addressof:drv 
 68      drv out_cur := drv out_buffer 
 69      drv out_stop := drv:out_buffer translate Byte udp_buffer_size 
 70    written := min (cast drv:out_stop Int).-.(cast drv:out_cur Int) maxi 
 71    memory_copy buf drv:out_cur written 
 72    drv out_cur := drv:out_cur translate Byte written 
 73   
 74   
 75  method drv flush level -> status 
 76    arg_rw UdpStreamDriver drv ; arg Int level ; arg Status status 
 77    if not drv:out_done and drv:out_cur<>drv:out_buffer 
 78      var Int expected := (cast drv:out_cur Int).-.(cast drv:out_buffer Int) 
 79      if trace 
 80        console "sending " expected " bytes" eol 
 81      status := shunt (os_sendto drv:drv:out_buffer expected drv:remote os_sockaddr_in:size)=expected success failure 
 82      drv out_done := true 
 83    else 
 84      status := success 
 85   
 86   
 87  method drv close -> status 
 88    arg_rw UdpStreamDriver drv ; arg ExtendedStatus status 
 89    if drv:in_buffer<>null 
 90      memory_free drv:in_buffer 
 91    if drv:out_buffer<>null 
 92      memory_free drv:out_buffer 
 93    if trace 
 94      console "closing socket "+(string drv:s)+"[lf]" 
 95    status := shunt (os_close drv:s)=0 success failure 
 96   
 97   
 98  method drv query command stream answer -> status 
 99    arg_rw UdpStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg_w Str answer ; arg ExtendedStatus status 
 100    if command="local_ip_address" 
 101      var os_sockaddr_in addr ; var Int addrlen := os_sockaddr_in:size 
 102      if (os_getsockname drv:addr addrlen)<>0 
 103        return failure 
 104      answer := ip_dot_notation addr:sin_addr 
 105      status := success 
 106    eif command="local_ip_port" 
 107      var os_sockaddr_in addr ; var Int addrlen := os_sockaddr_in:size 
 108      if (os_getsockname drv:addr addrlen)<>0 
 109        return failure 
 110      answer := 'convert to string' addr:sin_port 
 111      status := success 
 112    eif command="remote_ip_address" 
 113      answer := ip_dot_notation drv:remote:sin_addr 
 114      status := success 
 115    eif command="remote_ip_port" 
 116      answer := 'convert to string' drv:remote:sin_port 
 117      status := success 
 118    eif (command parse word:"timeout" drv:timeout) 
 119      status := success 
 120    else 
 121      status := failure 
 122   
 123  method drv configure command stream -> status 
 124    oarg_rw UdpStreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status 
 125    if command="reset" 
 126      drv flush anytime 
 127      drv in_done := false 
 128      drv out_done := false 
 129      drv out_cur := drv out_buffer 
 130      status := success 
 131    eif (command parse word:"timeout" drv:timeout) 
 132      status := success 
 133    eif (command parse word:"priority" any:(var Str param)) 
 134      if os_api="linux" 
 135        var Int tos := shunt param="high" os_IPTOS_LOWDELAY param="low" os_IPTOS_LOWCOST 0 
 136        os_setsockopt drv:os_IPPROTO_IP os_IP_TOS addressof:tos Int:size 
 137      status := success 
 138    else 
 139      status := failure 
 140   
 141   
 142 
 
 143   
 144   
 145  type UdpServerFileSystem 
 146    void 
 147  FileSystem maybe UdpServerFileSystem 
 148   
 149  (gvar Relation connection_sockets) flags := 4 
 150  gvar Sem connection_sem 
 151   
 152   
 153  method fs open name options flags stream support -> status 
 154    arg_rw UdpServerFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 155    var Int port 
 156    if (name eparse "/server/" port) 
 157      void 
 158    eif (name eparse "/server/any") 
 159      port := 0 
 160    else 
 161      return failure 
 162    stream_lock_handle 
 163    var Int := os_socket os_AF_INET os_SOCK_DGRAM 0 
 164    stream_unlock_handle s 
 165    if s<0 
 166      if debug 
 167        console "failed to create server socket[lf]" 
 168      connection_sem release 
 169      return failure 
 170    var Int optvalue := 1 
 171    if (os_setsockopt os_SOL_SOCKET os_SO_REUSEADDR addressof:optvalue Int:size)<>0 
 172      os_close s 
 173      return failure 
 174    var CBool ok := true 
 175    var os_sockaddr_in addr ; var Int addrlen 
 176    addr sin_family := os_AF_INET 
 177    addr sin_addr := 0 
 178    addr sin_port := port 
 179    if ok and (os_bind addr os_sockaddr_in:size)<>0 
 180      if debug 
 181        console "failed bind server socket[lf]" 
 182      ok := false 
 183    if not ok 
 184      os_close s 
 185      return failure 
 186    var Link:UdpStreamDriver drv :> new UdpStreamDriver 
 187    drv := s 
 188    drv timeout := undefined 
 189    stream stream_driver :> drv 
 190    stream stream_handle := s 
 191    if trace 
 192      console "opening socket "+(string drv:s)+"[lf]" 
 193    status := success 
 194   
 195   
 196 
 
 197   
 198   
 199  type UdpClientFileSystem 
 200    void 
 201  FileSystem maybe UdpClientFileSystem 
 202   
 203   
 204  method fs open name options flags stream support -> status 
 205    arg_rw UdpClientFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status 
 206    var uInt ipaddress ; var Int port 
 207    if (name eparse "//" (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4) "/client/" port)  
 208      ipaddress := (cast i1 uInt)*256^+ (cast i2 uInt)*256^+ (cast i3 uInt)*256 + (cast i4 uInt) 
 209    eif (name eparse "//" any:(var Str hostname) "/client/" port) 
 210      var Str ip := dns_query_prototype hostname dns_query_function 
 211      if (ip parse (var Int i1) "." (var Int i2) "." (var Int i3) "." (var Int i4)) 
 212        ipaddress := (cast i1 uInt)*256^+ (cast i2 uInt)*256^+ (cast i3 uInt)*256 + (cast i4 uInt) 
 213      else 
 214        if debug 
 215          console "failed to get ip address of "+hostname+"[lf]" 
 216        return failure 
 217    eif (name eparse "/client/" port)  
 218      ipaddress := 127*256^3+1 
 219    else 
 220      if debug 
 221        console "invalid udp client name: "+name+"[lf]" 
 222      return failure 
 223    stream_lock_handle 
 224    var Int := os_socket os_AF_INET os_SOCK_DGRAM 0 
 225    stream_unlock_handle s 
 226    if s<0 
 227      if debug 
 228        console "failed to create the UDP client socket[lf]" 
 229      return failure 
 230    var Int optvalue := 1 
 231    if (os_setsockopt os_SOL_SOCKET os_SO_REUSEADDR addressof:optvalue Int:size)<>0 
 232      os_close s 
 233      return failure 
 234    var uInt local_ip 
 235    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) 
 236      local_ip := (cast i1 uInt)*256^+ (cast i2 uInt)*256^+ (cast i3 uInt)*256 + (cast i4 uInt) 
 237    else 
 238      local_ip := 0 
 239    var Int local_port := options option "local_ip_port" Int 
 240    if local_ip<>or local_port=defined 
 241      var os_sockaddr_in addr ; var Int addrlen 
 242      addr sin_family := os_AF_INET 
 243      addr sin_addr := local_ip 
 244      addr sin_port := local_port 
 245      if (os_bind addr os_sockaddr_in:size)<>0 
 246        os_close s 
 247        return failure 
 248    var Link:UdpStreamDriver drv :> new UdpStreamDriver 
 249    drv := s 
 250    drv timeout := undefined 
 251    drv:remote sin_family := os_AF_INET 
 252    drv:remote sin_addr := ipaddress 
 253    drv:remote sin_port := port 
 254    stream stream_driver :> drv 
 255    stream stream_handle := s 
 256    status := success 
 257   
 258   
 259 
 
 260   
 261   
 262  gvar UdpClientFileSystem udp_client_file_system 
 263  pliant_multi_file_system mount "udp:" "" udp_client_file_system 
 264   
 265  gvar UdpServerFileSystem udp_server_file_system 
 266  pliant_multi_file_system mount "udp:/server/" "/server/" udp_server_file_system 
 267   
 268   
 269   
 270