Patch title: Release 94 bulk changes
Abstract:
File: /pliant/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 


function valid filename options -> v
  arg Str filename options ; arg CBool v
# 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 valid filename options -> v
  arg Str filename options ; arg CBool v
  if (filename search character:0 -1)<>(-1)
    return false
  if os_api="linux" or os_api="posix"
    if (filename search "/../" -1)<>(-1) and not (options op
      return false
  else
    if ((replace filename "\" "/") search "/../" -1)<>(-1) a
      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 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 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"
  if os_api="linux" or os_api="posix"
    if (filename search "/../" -1)<>(-1) and not (options op
      return false
  else
    if ((replace filename "\" "/") search "/../" -1)<>(-1) a
      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 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 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
        info options += " filesystem_device "+('convert to string' stat:st_dev)
        if stat:st_rdev<>0
          info options += " device "+('convert to string' stat:st_rdev)
      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 
      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
    if filename:len>0 and (filename filename:len-1)="/" and 
      status := failure
  else
    error "file_query is not implemented under "+os_api
    status := failure



export NativeFileSystem
      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 
      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
    if filename:len>0 and (filename filename:len-1)="/" and 
      status := failure
  else
    error "file_query is not implemented under "+os_api
    status := failure



export NativeFileSystem