Patch title: Release 93 bulk changes
Abstract:
File: /protocol/smb/client.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/os.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/stream/multi.pli"
module "/pliant/language/stream/filesystembase.pli"
module "/pliant/language/stream/openmode.pli"
module "/pliant/language/stream/flushmode.pli"
module "/pliant/language/stream/listmode.pli"
module "/pliant/language/os/linux64.pli"
module "/pliant/language/schedule/namedsem.pli"
module "/pliant/language/data/id.pli"

constant smb_library (shunt (file_query "file:/usr/lib/libsmbclient.so" standard)=success "/usr/lib/libsmbclient.so" "/lib/libsmbclient.so")
constant getdents_buffer_size 4096
constant verifynames true
constant advancedlocking true
constant trace2 false

(gvar TraceSlot smb_client_trace) configure "SMB client"


gvar Sem sem
if advancedlocking
  gvar NamedSem hsem

function lock
  sem request

function unlock
  sem release

function lock2 host
  arg Str host
  if advancedlocking
    sem rd_request
    hsem request host
  else
    sem request

function unlock2 host
  arg Str host
  if advancedlocking
    hsem release host
    sem rd_release
  else
    sem release


function smb_encode clear -> encoded
  arg Str clear encoded
  encoded := clear
  var Int i := 0
  while i<encoded:len
    var Int ch := encoded:i number
    if ch>="a":number and ch<="z":number or ch>="A":number and ch<="Z":number or ch>="0":number and ch<="9":number or ch="_":number or ch=".":number or ch="/":number or ch>=128
      i += 1
    else
      encoded := (encoded 0 i)+"%"+(right (string ch "radix 16") 2 "0")+(encoded i+1 encoded:len)
      i += 3
  

#----------------------------------------------------------------------
# Samba client library bindings


function smbc_init fn debug -> err
  arg Address fn ; arg Int debug err
  external smb_library "smbc_init"


function smbc_open url flags mode -> fd
  arg CStr url ; arg Int flags mode fd
  external smb_library "smbc_open"

function smbc_read fd buf size -> red
  arg Int fd ; arg Address buf ; arg Int size red
  external smb_library "smbc_read"

function smbc_write fd buf size -> written
  arg Int fd ; arg Address buf ; arg Int size written
  external smb_library "smbc_write"

function smbc_close fd -> err
  arg Int fd err
  external smb_library "smbc_close"


function smbc_opendir url -> dh
  arg CStr url ; arg Int dh
  external smb_library "smbc_opendir"

type smbc_dirent
  field uInt32 smbc_type
  field uInt32 dirlen
  field uInt32 commentlen
  field Address comment
  field uInt32 namelen

function smbc_readdir dh -> dirent
  arg Int dh ; arg_RW smbc_dirent dirent
  external smb_library "smbc_readdir"

function smbc_getdents dh buf size -> nb
  arg Int dh ; arg Address buf ; arg Int size nb
  external smb_library "smbc_getdents"

function smbc_closedir dh -> err
  arg Int dh err
  external smb_library "smbc_closedir"

function smbc_stat url stat -> err
  arg CStr url ; arg_w os_stat64 stat ; arg Int err
  external smb_library "smbc_stat"


function smbc_unlink url -> err
  arg CStr url ; arg Int err
  external smb_library "smbc_unlink"

function smbc_rename oldurl newurl -> err
  arg CStr oldurl newurl ; arg Int err
  external smb_library "smbc_rename"

function smbc_mkdir url -> err
  arg CStr url ; arg Int err
  external smb_library "smbc_mkdir"

function smbc_rmdir url -> err
  arg CStr url ; arg Int err
  external smb_library "smbc_rmdir"

function smbc_utime url utime -> err
  arg CStr url ; arg os_utimbuf utime ; arg Int err
  external smb_library "smbc_utime"


#----------------------------------------------------------------------
# Pliant filesystem


type SmbFileSystem
  void
FileSystem maybe SmbFileSystem


type SmbStreamDriver
  field Int handle
  field Str host
StreamDriver maybe SmbStreamDriver


method fs query filename options flags info -> status
  arg_rw SmbFileSystem fs ; arg Str filename options ; arg Int flags ; arg_rw FileInfo info ; arg ExtendedStatus status
  smb_client_trace trace "query " filename
  if verifynames and not (filename parse "//" any "/" any "/" any)
    return failure:"server or volume is missing"
  lock
  var Int err := smbc_stat "smb:"+smb_encode:filename (var os_stat64 stat)
  unlock
  if err<>0
    return failure
  info size := stat st_size
  info:datetime seconds := os_datetime_origin:seconds + stat:st_mtime
  if (os_S_ISDIR stat:st_mode) and (filename:len=0 or filename:(filename:len-1)<>"/")
    info:name resize info:name:len+1
    info:name info:name:len-1 := "/":0
  status := success


method fs configure filename options command -> status
  arg_rw SmbFileSystem fs ; arg Str filename options command ; arg ExtendedStatus status
  smb_client_trace trace "configure " filename " " command
  if verifynames and not (filename parse "//" any "/" any "/" any)
    return failure:"server or volume is missing"
  status := success
  var CBool some := false
  lock
  if (command option "mkdir")
    some := true
    if (smbc_mkdir "smb:"+smb_encode:filename)<>0
      status := failure
  if { var DateTime dt := command option "datetime" DateTime ; dt=defined }
    some := true
    var os_utimbuf buf
    buf modtime := cast dt:seconds-os_datetime_origin:seconds uInt32
    buf actime := buf modtime
    if (smbc_utime "smb:"+smb_encode:filename buf)<>0
      status := failure
  if { var Str target := command option "move" Str ; target<>"" }
    some := true
    if (smbc_rename "smb:"+smb_encode:filename "smb:"+smb_encode:target)<>0
      if not (command option "force") or (smbc_unlink "smb:"+smb_encode:target)<>0 or (smbc_rename "smb:"+smb_encode:filename "smb:"+smb_encode:target)<>0
        status := failure
  if (command option "delete")
    some := true
    if (smbc_unlink "smb:"+smb_encode:filename)<>0
      status := failure
  if (command option "rmdir")
    some := true
    if (smbc_rmdir "smb:"+smb_encode:filename)<>0
      status := failure
  unlock
  if not some
    status := failure


method fs list path options flags files -> supported_flags
  oarg_rw SmbFileSystem fs ; arg Str path options ; arg_rw List files ; arg Int flags supported_flags
  supported_flags := extended
  smb_client_trace trace "list " path
  if (verifynames or advancedlocking) and not (path parse "//" any:(var Str host) "/" any "/" any)
    return failure:"server or volume is missing"
  lock
  var Int fd := smbc_opendir "smb:"+smb_encode:path
  if fd<0 and path:len>0 and (path path:len-1)="/"
    fd := smbc_opendir "smb:"+smb_encode:(path 0 path:len-1)
  unlock
  if fd<0
    if (flags .and. notifyfailure)<>0
      var Link:FileInfo info :> new FileInfo
      info name := path
      info status := failure
      files append addressof:info
    return
  if getdents_buffer_size<>0
    var Address buffer := memory_allocate getdents_buffer_size null
    while { lock2 host ; var Int size := smbc_getdents fd buffer getdents_buffer_size ; unlock2 host ; size>0 }
      var Int offset := 0
      while offset<size
        var Int dirlen := (buffer translate Byte offset) map Int 1
        var Int namelen := (buffer translate Byte offset) map Int 4
        (var Str filename) set (buffer translate Byte offset+5*Int:size) namelen-1 false
        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 info
          files append addressof:info
        offset += dirlen
    memory_free buffer
  else
    while { lock2 ; var Pointer:smbc_dirent dirent :> smbc_readdir fd ; unlock2 ; exists dirent }
      (var Str filename) set (addressof:dirent translate smbc_dirent) (max dirent:namelen-1 0) false
      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 info
        files append addressof:info
        # console "-> " filename " (" filename:len ") -> " info:name " " (shunt info:status=success "ok" "failed") eol
  lock
  var Int err := smbc_closedir fd
  unlock
  if err<>0
    if (flags .and. notifyfailure)<>0
      var Link:FileInfo info :> new FileInfo
      info name := path
      info status := failure 
      files append addressof:info
    

method fs open name options flags stream support -> status
  arg_rw SmbFileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
  smb_client_trace trace "open " name
  if not (name parse "//" any:(var Str host) "/" any "/" any)
    return failure:"server or volume is missing"
  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
  access += os_O_LARGEFILE
  var Int mode := options option "file_mode" Int
  if mode=undefined
    mode := os_default_file_mode
  lock
  var Int handle := smbc_open "smb:"+smb_encode:name access mode
  unlock
  if handle>=0
    var Pointer:SmbStreamDriver nd :> new SmbStreamDriver
    nd handle := handle
    nd host := host
    stream stream_driver :> nd
    status := success
  else
    status := failure


method nd read buf mini maxi -> red
  arg_rw SmbStreamDriver nd ; arg Address buf ; arg Int mini maxi red
  lock2 nd:host
  red := smbc_read nd:handle buf maxi
  unlock2 nd:host
  red := max red 0
  if trace2 or red=0
    smb_client_trace trace "read " mini " " maxi " -> " red


method nd write buf mini maxi -> written
  arg_rw SmbStreamDriver nd ; arg Address buf ; arg Int mini maxi written
  lock2 nd:host
  written := smbc_write nd:handle buf maxi
  unlock2 nd:host
  written := max written 0
  if trace2 or written=0
    smb_client_trace trace "write " mini " " maxi " -> " written


method nd close -> status
  arg_rw SmbStreamDriver nd ; arg ExtendedStatus status
  smb_client_trace trace "close " 
  lock
  status := shunt (smbc_close nd:handle)=0 success failure
  unlock
  smb_client_trace trace "close"


function auth srv shr wg wglen un unlen pw pwlen
  arg CStr srv shr
  arg Address wg ; arg Int wglen
  arg Address un ; arg Int unlen
  arg Address pw ; arg Int pwlen
  external_calling_convention

gvar SmbFileSystem smb_file_system
if (smbc_init (the_function auth CStr CStr Address Int Address Int Address Int):executable 0)=0
  entry_root addressof:(the_function auth CStr CStr Address Int Address Int Address Int)
  pliant_multi_file_system mount "smb:" "" smb_file_system