Patch title: Release 93 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 


# 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 


if os_api="linux"
  function set_ext2_flags filename flags_on flags_off -> status
    arg Str filename ; arg uInt flags_on flags_off ; arg Status status
    status := failure
    stream_lock_handle
    var Int h := os_open filename os_O_RDONLY 0
    stream_unlock_handle h
    if h>=0
      if (os_ioctl h 80046601h addressof:(var uInt flags))=0
        flags := (flags .and. .not. flags_off) .or. flags_on
        if (os_ioctl h 40046602h addressof:(var uInt flags))=0
          status := success
      os_close h

method fs configure filename options command -> status
  arg_rw NativeFileSystem fs ; arg Str filename options comm
  if not (valid filename options)
    return failure
  if os_api="linux" or os_api="posix"
    status := success
    var CBool some := false
    if (command option "mkdir")
      some := true
      var Int mode := options option "directory_mode" Int
      if mode=undefined
        mode := os_default_directory_mode
      if (os_mkdir filename mode)<>0
        status := failure
    if { var Str link := command option "link" Str ; link<>"
      some := true
      var Str target := shunt filename:len<>0 and filename:(
      if (os_symlink link target)<>0
        if not (command option "force") or (os_unlink target
          status := failure
    if { var DateTime dt := command option "datetime" DateTi
      some := true
      var os_utimbuf buf
      buf modtime := cast dt:seconds-os_datetime_origin:seco
      buf actime := buf modtime
      if (os_utime filename buf)<>0
        status := failure
    var Int uid := command option "uid" Int
    var Int gid := command option "gid" Int
    if uid=defined or gid=defined
      some := true
      if (os_lchown filename (shunt uid=defined uid -1) (shu
        status := failure
    if { var Int mode := command option "mode" Int ; mode=de
      some := true
      if (os_chmod filename mode)<>0
        status := failure
    if { var Str clone := command option "clone" Str ; clone
      some := true
      if (os_link filename clone)<>0
        if not (command option "force") or (os_unlink clone)
          status := failure
    if { var Str target := command option "move" Str ; targe
      some := true
      if (os_rename filename target)<>0
        if not (command option "force") or (os_unlink target
          status := failure
    if (command option "delete")
      some := true
      if true
        if os_unlink:filename<>0
          status := failure
      else
        var Str namez := filename
        if namez:len>1 and (namez namez:len-1)="/"
          namez := namez 0 namez:len-1
        if (os_unlink namez)<>0
          status := failure
    if (command option "rmdir")
      some := true
      if (os_rmdir filename)<>0
        status := failure
    if (command option "flush")
      some := true
      stream_lock_handle
      var Int fd := os_open filename os_O_RDONLY 0
      stream_unlock_handle fd
      if fd<0
        status := failure
      else
        if os_fsync:fd<>0
          status := failure
        os_close fd
method fs configure filename options command -> status
  arg_rw NativeFileSystem fs ; arg Str filename options comm
  if not (valid filename options)
    return failure
  if os_api="linux" or os_api="posix"
    status := success
    var CBool some := false
    if (command option "mkdir")
      some := true
      var Int mode := options option "directory_mode" Int
      if mode=undefined
        mode := os_default_directory_mode
      if (os_mkdir filename mode)<>0
        status := failure
    if { var Str link := command option "link" Str ; link<>"
      some := true
      var Str target := shunt filename:len<>0 and filename:(
      if (os_symlink link target)<>0
        if not (command option "force") or (os_unlink target
          status := failure
    if { var DateTime dt := command option "datetime" DateTi
      some := true
      var os_utimbuf buf
      buf modtime := cast dt:seconds-os_datetime_origin:seco
      buf actime := buf modtime
      if (os_utime filename buf)<>0
        status := failure
    var Int uid := command option "uid" Int
    var Int gid := command option "gid" Int
    if uid=defined or gid=defined
      some := true
      if (os_lchown filename (shunt uid=defined uid -1) (shu
        status := failure
    if { var Int mode := command option "mode" Int ; mode=de
      some := true
      if (os_chmod filename mode)<>0
        status := failure
    if { var Str clone := command option "clone" Str ; clone
      some := true
      if (os_link filename clone)<>0
        if not (command option "force") or (os_unlink clone)
          status := failure
    if { var Str target := command option "move" Str ; targe
      some := true
      if (os_rename filename target)<>0
        if not (command option "force") or (os_unlink target
          status := failure
    if (command option "delete")
      some := true
      if true
        if os_unlink:filename<>0
          status := failure
      else
        var Str namez := filename
        if namez:len>1 and (namez namez:len-1)="/"
          namez := namez 0 namez:len-1
        if (os_unlink namez)<>0
          status := failure
    if (command option "rmdir")
      some := true
      if (os_rmdir filename)<>0
        status := failure
    if (command option "flush")
      some := true
      stream_lock_handle
      var Int fd := os_open filename os_O_RDONLY 0
      stream_unlock_handle fd
      if fd<0
        status := failure
      else
        if os_fsync:fd<>0
          status := failure
        os_close fd
    if os_api="linux" and (command option "sync")
      some := true
      if (set_ext2_flags filename 8 0)=failure
        status := failure
    if os_api="linux" and (command option "async")
      some := true
      if (set_ext2_flags filename 0 8)=failure
        status := failure
    if os_api="linux" and (command option "dirsync")
      some := true
      if (set_ext2_flags filename 10000h 0)=failure
        status := failure
    if os_api="linux" and (command option "nodirsync")
      some := true
      if (set_ext2_flags filename 0 10000h)=failure
        status := failure
    if os_api="linux" and (command option "journal")
      some := true
      if (set_ext2_flags filename 4000h 0)=failure
        status := failure
    if os_api="linux" and (command option "nojournal")
      some := true
      if (set_ext2_flags filename 0 4000h)=failure
        status := failure
    if not some
      status := failure
  eif os_api="win32"
    var Str namez := replace filename "/" "\"
    if namez:len>1 and (namez namez:len-1)="\"
      namez := namez 0 namez:len-1
    status := success
    var CBool some := false
    if command="mkdir"
      some := true
      if not (os_CreateDirectory namez null)
        status := failure
    if command="delete"
      some := true
      if not (os_DeleteFile namez)
        status := failure
    if command="rmdir"
      some := true
      if not (os_RemoveDirectory namez)
        status := failure
    if not some
      status := failure
  eif os_api="os2"
    var Str namez := replace filename "/" "\"
    if namez:len>1 and (namez namez:len-1)="\"
      namez := namez 0 namez:len-1
    status := success
    var CBool some := false
    if command="mkdir"
      some := true
      if (os_DosCreateDir namez null)<>0
        status := failure
    if command="delete"
      some := true
      if (os_DosDelete namez)<>0
        status := failure
    if command="rmdir"
      some := true
      if (os_DosDeleteDir namez)<>0
        status := failure
    if not some
      status := failure
  else
    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
  if os_api="linux"
    stream_lock_handle
    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 
    if not some
      status := failure
  eif os_api="win32"
    var Str namez := replace filename "/" "\"
    if namez:len>1 and (namez namez:len-1)="\"
      namez := namez 0 namez:len-1
    status := success
    var CBool some := false
    if command="mkdir"
      some := true
      if not (os_CreateDirectory namez null)
        status := failure
    if command="delete"
      some := true
      if not (os_DeleteFile namez)
        status := failure
    if command="rmdir"
      some := true
      if not (os_RemoveDirectory namez)
        status := failure
    if not some
      status := failure
  eif os_api="os2"
    var Str namez := replace filename "/" "\"
    if namez:len>1 and (namez namez:len-1)="\"
      namez := namez 0 namez:len-1
    status := success
    var CBool some := false
    if command="mkdir"
      some := true
      if (os_DosCreateDir namez null)<>0
        status := failure
    if command="delete"
      some := true
      if (os_DosDelete namez)<>0
        status := failure
    if command="rmdir"
      some := true
      if (os_DosDeleteDir namez)<>0
        status := failure
    if not some
      status := failure
  else
    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
  if os_api="linux"
    stream_lock_handle
    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 
        info status := success
        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
      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
          info status := success
          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 nd configure command stream -> status
  arg_rw NativeStreamDriver nd ; arg Str command ; arg_rw St
  if os_api="linux" and (command parse word:"seek" (var Intn
    if (stream:stream_flags .and. out)<>0
      stream flush anytime
    stream stream_read_cur := stream stream_read_stop
    var uInt high := cast pos\(cast 2 Intn)^32 uInt
    var uInt low := cast pos%(cast 2 Intn)^32 uInt
    check high*(cast 2 Intn)^32+low=pos
    status := shunt (os_llseek nd:handle high low addressof:
  eif os_api="posix" and (command parse word:"seek" (var Int
    if (stream:stream_flags .and. out)<>0
      stream flush anytime
    stream stream_read_cur := stream stream_read_stop
    status := shunt (os_lseek nd:handle pos os_SEEK_SET)>=0 
  eif os_api="win32" and (command parse word:"seek" (var Int
    if (stream:stream_flags .and. out)<>0
      stream flush anytime
    stream stream_read_cur := stream stream_read_stop
    status := shunt (os_SetFilePointer nd:handle (cast pos u
          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 nd configure command stream -> status
  arg_rw NativeStreamDriver nd ; arg Str command ; arg_rw St
  if os_api="linux" and (command parse word:"seek" (var Intn
    if (stream:stream_flags .and. out)<>0
      stream flush anytime
    stream stream_read_cur := stream stream_read_stop
    var uInt high := cast pos\(cast 2 Intn)^32 uInt
    var uInt low := cast pos%(cast 2 Intn)^32 uInt
    check high*(cast 2 Intn)^32+low=pos
    status := shunt (os_llseek nd:handle high low addressof:
  eif os_api="posix" and (command parse word:"seek" (var Int
    if (stream:stream_flags .and. out)<>0
      stream flush anytime
    stream stream_read_cur := stream stream_read_stop
    status := shunt (os_lseek nd:handle pos os_SEEK_SET)>=0 
  eif os_api="win32" and (command parse word:"seek" (var Int
    if (stream:stream_flags .and. out)<>0
      stream flush anytime
    stream stream_read_cur := stream stream_read_stop
    status := shunt (os_SetFilePointer nd:handle (cast pos u
  if os_api="linux" and command="journal"
    status := failure
    if (os_ioctl nd:handle 80046601h addressof:(var uInt flags))=0
      flags := flags .or. 4000h
      if (os_ioctl nd:handle 40046602h addressof:(var uInt flags))=0
        status := success
  else
    status=failure


export NativeFileSystem
  else
    status=failure


export NativeFileSystem