Patch title: Release 92 bulk changes
Abstract:
File: /language/stream/native.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 

scope "/pliant/language/stream/"
module "ring.pli"
module "/pliant/language/os/socket.pli"
# 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 

scope "/pliant/language/stream/"
module "ring.pli"
module "/pliant/language/os/socket.pli"
if os_api="linux"
  module "/pliant/language/os/linux64.pli"



function valid filename options -> v
  arg Str filename options ; arg CBool v



function valid filename options -> v
  arg Str filename options ; arg CBool v
  if (filename search ".." -1)<>(-1) and not (options option
    return false
  if os_api="linux" or os_api="posix"
    if (filename search "/../" -1)<>(-1) and not (options option "backward_allowed")
      return false
  else
    if ((replace filename "\" "/") search "/../" -1)<>(-1) and not (options option "backward_allowed")
      return false
  if pliant_debugging_level>=2 and (filename search "//" -1)
    return false
  v := true


method fs query filename options flags info -> status
  arg_rw NativeFileSystem fs ; arg Str filename options ; ar
  if not (valid filename options)
    return failure
  if (flags .and. level_flags)>=extended
    info:options += " os_name "+string:filename
  if os_api="linux" or os_api="posix"
  if pliant_debugging_level>=2 and (filename search "//" -1)
    return false
  v := true


method fs query filename options flags info -> status
  arg_rw NativeFileSystem fs ; arg Str filename options ; ar
  if not (valid filename options)
    return failure
  if (flags .and. level_flags)>=extended
    info:options += " os_name "+string:filename
  if os_api="linux" or os_api="posix"
    var Int err := os_stat filename (var os_stat stat)
    if os_api="linux"
      var Int err := os_stat64 filename (var os_stat64 stat)
    else
      var Int err := os_stat filename (var os_stat stat)
    if err<>0
      if (flags .and. deadlinks)=0
        return failure
    if err<>0
      if (flags .and. deadlinks)=0
        return failure
      if (os_lstat filename stat)<>0
        return failure
      if os_api="linux"
        if (os_lstat64 filename stat)<>0
          return failure
      else
        if (os_lstat filename stat)<>0
          return failure
      if (flags .and. level_flags)>=extended
        info options += " deadlink"
    info size := stat st_size
    info:datetime seconds := os_datetime_origin:seconds + st
    if (os_S_ISDIR stat:st_mode) and (filename:len=0 or file
      info:name resize info:name:len+1
      info:name info:name:len-1 := "/":0
    if (flags .and. level_flags)>=extended
      info options += " mode "+('convert to string' stat:st_
      info options += " uid "+('convert to string' stat:st_u
      info options += " gid "+('convert to string' stat:st_g
      (var DateTime dt) seconds := os_datetime_origin:second
      dt split (var Int year) (var Int month) (var Int day) 
      info options += " read_datetime "+string:year+"/"+(rig
      if os_api="linux"
        info options += " device "+('convert to string' stat
      var Address buffer2 := memory_allocate readlink_buffer
      var Int size2 := os_readlink filename buffer2 readlink
      if size2>=0
        var Str link ; link set buffer2 size2 false
        info options += " link "+string:link
      memory_free buffer2
    status := success
  eif os_api="win32"
    var Str wname := replace filename "/" "\"
    if filename:len>1 and (filename filename:len-1)="/":0
      if not (filename:len>2 and (filename filename:len-2)="
        wname := wname 0 wname:len-1
    var Int handle := os_FindFirstFile wname (var os_FIND_DA
    if handle=os_INVALID_HANDLE_VALUE
      return failure
    if (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DIRECT
      info name += "/"
    info size := data nFileSizeLow
    info:datetime seconds := os_datetime_origin:seconds + da
    os_FindClose handle
    status := success
      if (flags .and. level_flags)>=extended
        info options += " deadlink"
    info size := stat st_size
    info:datetime seconds := os_datetime_origin:seconds + st
    if (os_S_ISDIR stat:st_mode) and (filename:len=0 or file
      info:name resize info:name:len+1
      info:name info:name:len-1 := "/":0
    if (flags .and. level_flags)>=extended
      info options += " mode "+('convert to string' stat:st_
      info options += " uid "+('convert to string' stat:st_u
      info options += " gid "+('convert to string' stat:st_g
      (var DateTime dt) seconds := os_datetime_origin:second
      dt split (var Int year) (var Int month) (var Int day) 
      info options += " read_datetime "+string:year+"/"+(rig
      if os_api="linux"
        info options += " device "+('convert to string' stat
      var Address buffer2 := memory_allocate readlink_buffer
      var Int size2 := os_readlink filename buffer2 readlink
      if size2>=0
        var Str link ; link set buffer2 size2 false
        info options += " link "+string:link
      memory_free buffer2
    status := success
  eif os_api="win32"
    var Str wname := replace filename "/" "\"
    if filename:len>1 and (filename filename:len-1)="/":0
      if not (filename:len>2 and (filename filename:len-2)="
        wname := wname 0 wname:len-1
    var Int handle := os_FindFirstFile wname (var os_FIND_DA
    if handle=os_INVALID_HANDLE_VALUE
      return failure
    if (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DIRECT
      info name += "/"
    info size := data nFileSizeLow
    info:datetime seconds := os_datetime_origin:seconds + da
    os_FindClose handle
    status := success
    if filename:len>0 and (filename filename:len-1)="/" and (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DIRECTORY)=0
      status := failure
  eif os_api="os2"
    var Str oname := replace filename "/" "\"
    if filename:len>1 and (filename filename:len-1)="/":0
      if not (filename:len>2 and (filename filename:len-2)="
        oname := oname 0 oname:len-1
    var Int handle := 1 ; var Int count := 1
    var Int err := os_DosFindFirst oname handle FILE_DIRECTO
    if err<>0 or count=0
      return failure
    if (data:attrFile .and. FILE_DIRECTORY)<>0 and (filename
      info name += "/"
    info size := data cbFile
    var FDATE d := data fdateLastWrite ; var FTIME t := data
    info:datetime := datetime 1980+d:year d:month d:day t:ho
    os_DosFindClose handle
    status := success
  eif os_api="os2"
    var Str oname := replace filename "/" "\"
    if filename:len>1 and (filename filename:len-1)="/":0
      if not (filename:len>2 and (filename filename:len-2)="
        oname := oname 0 oname:len-1
    var Int handle := 1 ; var Int count := 1
    var Int err := os_DosFindFirst oname handle FILE_DIRECTO
    if err<>0 or count=0
      return failure
    if (data:attrFile .and. FILE_DIRECTORY)<>0 and (filename
      info name += "/"
    info size := data cbFile
    var FDATE d := data fdateLastWrite ; var FTIME t := data
    info:datetime := datetime 1980+d:year d:month d:day t:ho
    os_DosFindClose handle
    status := success
    if filename:len>0 and (filename filename:len-1)="/" and (data:attrFile .and. FILE_DIRECTORY)=0
      status := failure
  else
    error "file_query is not implemented under "+os_api
    status := failure



method fs list path options flags files -> supported_flags
  oarg_rw NativeFileSystem fs ; arg Str path options ; arg I
  supported_flags := extended
  if not (valid path options) or path:len=0 or (path path:le
  else
    error "file_query is not implemented under "+os_api
    status := failure



method fs list path options flags files -> supported_flags
  oarg_rw NativeFileSystem fs ; arg Str path options ; arg I
  supported_flags := extended
  if not (valid path options) or path:len=0 or (path path:le
    return failure
    return
  if os_api="linux"
    stream_lock_handle
  if os_api="linux"
    stream_lock_handle
    var Int fd := os_open path os_O_RDONLY 0
    var Int fd := os_open path os_O_RDONLY+os_O_LARGEFILE 0
    stream_unlock_handle fd
    if fd<0
      return
    var Address buffer := memory_allocate getdents_buffer_si
    while { var Int size := os_getdents fd buffer getdents_b
      var Int offset := 0
      while offset<size
        var Pointer:os_dirent de :> (buffer translate Byte o
        (var CStr cname) characters := addressof de:d_name
        var Str filename := cname
        if filename<>"." and filename<>".."
          var Link:FileInfo info :> new FileInfo
          info name := path+filename
          info size := undefined
          info datetime := undefined
          info options := ""
          info status := fs query path+filename options flag
          files append addressof:info
        offset += de:d_reclen
    memory_free buffer
    os_close fd
  eif os_api="posix"
    # stream_lock_handle
    var Address fd := os_opendir path
    # stream_unlock_handle fd
    if fd=null
      return
    while { var Pointer:os_dirent de :> os_readdir fd ; addr
      (var CStr cname) characters := addressof de:d_name
      var Str filename := cname
      if filename<>"." and filename<>".."
        var Link:FileInfo info :> new FileInfo
        info name := path+filename
        info size := undefined
        info datetime := undefined
        info options := ""
        info status := fs query path+filename options flags 
        files append addressof:info
    os_closedir fd
  eif os_api="win32"
    var Str wname := (replace path "/" "\")+"*.*"
    var Int handle := os_FindFirstFile wname (var os_FIND_DA
    var CBool more := handle<>os_INVALID_HANDLE_VALUE
    while more
      (var CStr cname) characters := addressof data:cFileNam
      var Str filename := cname
      if filename<>"." and filename<>".."
        var Link:FileInfo info :> new FileInfo
        info name := path+filename
        if (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DI
          info name += "/"
        info size := data nFileSizeLow
        info:datetime seconds := os_datetime_origin:seconds 
        files append addressof:info
      more := os_FindNextFile handle data
    os_FindClose handle
  eif os_api="os2"
    var Str oname := (replace path "/" "\")+"*.*"
    var Int size := 4096 ; var Address buf := memory_allocat
    var Int handle := 1 ; var Int count := size
    var Int err := os_DosFindFirst oname handle FILE_DIRECTO
    while err=0 and count<>0
      var Pointer:FILEFINDBUF3 data :> buf map FILEFINDBUF3
      for (var Int i) 0 count-1
        (var Str filename) set (memory_allocate data:cchName
        memory_copy (addressof data:achName) filename:charac
        if filename<>"." and filename<>".."
          var Link:FileInfo info :> new FileInfo
          info name:= path+filename
          if (data:attrFile .and. FILE_DIRECTORY)<>0 and (fi
            info name += "/"
          info size := data cbFile
          var FDATE d := data fdateLastWrite ; var FTIME t :
          info:datetime := datetime 1980+d:year d:month d:da
          files append addressof:info
        data :> (addressof:data translate Byte data:oNextEnt
      err := os_DosFindNext handle buf size count
    memory_free buf
    os_DosFindClose handle
  else
    error "file_list is not implemented under "+os_api


method fs open name options flags stream support -> status
  arg_rw NativeFileSystem fs ; arg Str name options ; arg In
  if not (valid name options)
    return failure
  if os_api="linux" or os_api="posix"
    var Int access
    if (flags .and. append)=append
      access := os_O_RDWR+os_O_CREAT+os_O_APPEND
    eif (flags .and. in_out)=in
      access := os_O_RDONLY
    eif (flags .and. in_out)=out
      access := os_O_RDWR+os_O_CREAT+os_O_TRUNC
    else
      check (flags .and. in_out)=in_out
      access := os_O_RDWR+os_O_CREAT
    if (options option "timeout" Float)=defined
      access += os_O_NONBLOCK
    stream_unlock_handle fd
    if fd<0
      return
    var Address buffer := memory_allocate getdents_buffer_si
    while { var Int size := os_getdents fd buffer getdents_b
      var Int offset := 0
      while offset<size
        var Pointer:os_dirent de :> (buffer translate Byte o
        (var CStr cname) characters := addressof de:d_name
        var Str filename := cname
        if filename<>"." and filename<>".."
          var Link:FileInfo info :> new FileInfo
          info name := path+filename
          info size := undefined
          info datetime := undefined
          info options := ""
          info status := fs query path+filename options flag
          files append addressof:info
        offset += de:d_reclen
    memory_free buffer
    os_close fd
  eif os_api="posix"
    # stream_lock_handle
    var Address fd := os_opendir path
    # stream_unlock_handle fd
    if fd=null
      return
    while { var Pointer:os_dirent de :> os_readdir fd ; addr
      (var CStr cname) characters := addressof de:d_name
      var Str filename := cname
      if filename<>"." and filename<>".."
        var Link:FileInfo info :> new FileInfo
        info name := path+filename
        info size := undefined
        info datetime := undefined
        info options := ""
        info status := fs query path+filename options flags 
        files append addressof:info
    os_closedir fd
  eif os_api="win32"
    var Str wname := (replace path "/" "\")+"*.*"
    var Int handle := os_FindFirstFile wname (var os_FIND_DA
    var CBool more := handle<>os_INVALID_HANDLE_VALUE
    while more
      (var CStr cname) characters := addressof data:cFileNam
      var Str filename := cname
      if filename<>"." and filename<>".."
        var Link:FileInfo info :> new FileInfo
        info name := path+filename
        if (data:dwFileAttributes .and. os_FILE_ATTRIBUTE_DI
          info name += "/"
        info size := data nFileSizeLow
        info:datetime seconds := os_datetime_origin:seconds 
        files append addressof:info
      more := os_FindNextFile handle data
    os_FindClose handle
  eif os_api="os2"
    var Str oname := (replace path "/" "\")+"*.*"
    var Int size := 4096 ; var Address buf := memory_allocat
    var Int handle := 1 ; var Int count := size
    var Int err := os_DosFindFirst oname handle FILE_DIRECTO
    while err=0 and count<>0
      var Pointer:FILEFINDBUF3 data :> buf map FILEFINDBUF3
      for (var Int i) 0 count-1
        (var Str filename) set (memory_allocate data:cchName
        memory_copy (addressof data:achName) filename:charac
        if filename<>"." and filename<>".."
          var Link:FileInfo info :> new FileInfo
          info name:= path+filename
          if (data:attrFile .and. FILE_DIRECTORY)<>0 and (fi
            info name += "/"
          info size := data cbFile
          var FDATE d := data fdateLastWrite ; var FTIME t :
          info:datetime := datetime 1980+d:year d:month d:da
          files append addressof:info
        data :> (addressof:data translate Byte data:oNextEnt
      err := os_DosFindNext handle buf size count
    memory_free buf
    os_DosFindClose handle
  else
    error "file_list is not implemented under "+os_api


method fs open name options flags stream support -> status
  arg_rw NativeFileSystem fs ; arg Str name options ; arg In
  if not (valid name options)
    return failure
  if os_api="linux" or os_api="posix"
    var Int access
    if (flags .and. append)=append
      access := os_O_RDWR+os_O_CREAT+os_O_APPEND
    eif (flags .and. in_out)=in
      access := os_O_RDONLY
    eif (flags .and. in_out)=out
      access := os_O_RDWR+os_O_CREAT+os_O_TRUNC
    else
      check (flags .and. in_out)=in_out
      access := os_O_RDWR+os_O_CREAT
    if (options option "timeout" Float)=defined
      access += os_O_NONBLOCK
    if os_api="linux"
      access += os_O_LARGEFILE
    var Int mode := options option "file_mode" Int
    if mode=undefined
      mode := os_default_file_mode
    stream_lock_handle
    var Int handle := os_open name access mode
    stream_unlock_handle handle
  eif os_api="win32"
    var uInt access := (shunt (flags .and. in)<>0 os_GENERIC
    var uInt share :=  os_FILE_SHARE_READ .or. os_FILE_SHARE
    var uInt creation := shunt ((flags .and. in_out)=in_out 
    var uInt wflags := os_FILE_ATTRIBUTE_NORMAL .or. (shunt 
    if (options option "win32_device")
      share := 0 ; creation := os_OPEN_EXISTING ; wflags := 
    var Int handle := os_CreateFile name access share null c
    if (flags .and. append)<>0
      var uInt lpDistanceToMoveHigh := 0
      os_SetFilePointer handle 0 lpDistanceToMoveHigh os_FIL
  eif os_api="os2"
    var Int openflags openmode action handle
    if (flags .and. in_out)=in
      openflags := OPEN_ACTION_FAIL_IF_NEW+OPEN_ACTION_OPEN_
      openmode := OPEN_ACCESS_READONLY+OPEN_SHARE_DENYWRITE
    eif (flags .and. in_out)=out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_REP
      openmode := OPEN_ACCESS_WRITEONLY+OPEN_SHARE_DENYREADW
    else
      check (flags .and. in_out)=in_out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_OPE
      openmode := OPEN_ACCESS_READWRITE+OPEN_SHARE_DENYREADW
    if (flags .and. nocache)<>0
      openmode := openmode + OPEN_FLAGS_NO_CACHE
    openmode := openmode + OPEN_FLAGS_SEQUENTIAL
    var Int try_count := 1 ; var Int err := ERROR_TOO_MANY_O
    var Str os2name := replace name "/" "\"
    while try_count>=0 and err=ERROR_TOO_MANY_OPEN_FILES
      err := os_DosOpen os2name handle action 0 FILE_NORMAL 
      if err<>0
        handle := -1
      if err=ERROR_TOO_MANY_OPEN_FILES
        var Int add := 5 ; var Int nb
        os_DosSetRelMaxFH add nb
      try_count := try_count-1
    if (flags .and. append)<>0
      os_DosSetFilePtr handle 0 FILE_END (var uInt drop)
  else
    error "not implemented under "+os_api
    var Int handle := 0
  if handle>=0
    var Pointer:NativeStreamDriver nd :> new NativeStreamDri
    nd handle := handle
    nd timeout := options option "timeout" Float
    stream stream_driver :> nd
    stream stream_handle := handle
    status := success
  else
    status := failure



export NativeFileSystem
    var Int mode := options option "file_mode" Int
    if mode=undefined
      mode := os_default_file_mode
    stream_lock_handle
    var Int handle := os_open name access mode
    stream_unlock_handle handle
  eif os_api="win32"
    var uInt access := (shunt (flags .and. in)<>0 os_GENERIC
    var uInt share :=  os_FILE_SHARE_READ .or. os_FILE_SHARE
    var uInt creation := shunt ((flags .and. in_out)=in_out 
    var uInt wflags := os_FILE_ATTRIBUTE_NORMAL .or. (shunt 
    if (options option "win32_device")
      share := 0 ; creation := os_OPEN_EXISTING ; wflags := 
    var Int handle := os_CreateFile name access share null c
    if (flags .and. append)<>0
      var uInt lpDistanceToMoveHigh := 0
      os_SetFilePointer handle 0 lpDistanceToMoveHigh os_FIL
  eif os_api="os2"
    var Int openflags openmode action handle
    if (flags .and. in_out)=in
      openflags := OPEN_ACTION_FAIL_IF_NEW+OPEN_ACTION_OPEN_
      openmode := OPEN_ACCESS_READONLY+OPEN_SHARE_DENYWRITE
    eif (flags .and. in_out)=out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_REP
      openmode := OPEN_ACCESS_WRITEONLY+OPEN_SHARE_DENYREADW
    else
      check (flags .and. in_out)=in_out
      openflags := OPEN_ACTION_CREATE_IF_NEW+OPEN_ACTION_OPE
      openmode := OPEN_ACCESS_READWRITE+OPEN_SHARE_DENYREADW
    if (flags .and. nocache)<>0
      openmode := openmode + OPEN_FLAGS_NO_CACHE
    openmode := openmode + OPEN_FLAGS_SEQUENTIAL
    var Int try_count := 1 ; var Int err := ERROR_TOO_MANY_O
    var Str os2name := replace name "/" "\"
    while try_count>=0 and err=ERROR_TOO_MANY_OPEN_FILES
      err := os_DosOpen os2name handle action 0 FILE_NORMAL 
      if err<>0
        handle := -1
      if err=ERROR_TOO_MANY_OPEN_FILES
        var Int add := 5 ; var Int nb
        os_DosSetRelMaxFH add nb
      try_count := try_count-1
    if (flags .and. append)<>0
      os_DosSetFilePtr handle 0 FILE_END (var uInt drop)
  else
    error "not implemented under "+os_api
    var Int handle := 0
  if handle>=0
    var Pointer:NativeStreamDriver nd :> new NativeStreamDri
    nd handle := handle
    nd timeout := options option "timeout" Float
    stream stream_driver :> nd
    stream stream_handle := handle
    status := success
  else
    status := failure



export NativeFileSystem