Patch title: Release 94 bulk changes
Abstract:
File: /pliant/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 smb_library (shunt (file_query "file:/usr/lib/libsmbclient.so" standard)=success "/usr/lib/libsmbclient.so" (file_query "file:/usr/lib/libsmbclient.so.0" standard)=success "/usr/lib/libsmbclient.so.0" "/lib/libsmbclient.so")
# constant smb_library "/usr/src/samba-3.0.8/source/bin/libsmbclient.so"
constant getdents_buffer_size 4096
constant verifynames true
constant somelocking true
constant advancedlocking true
constant trace2 false

(gvar TraceSlot smb_client_trace) configure "SMB client"


gvar Sem sem
if advancedlocking
  gvar NamedSem hsem
if somelocking
  gvar Sem sem
  if advancedlocking
    gvar NamedSem hsem

function lock
  sem request
  if somelocking
    sem request

function unlock
  sem release
  if somelocking
    sem release

function lock2 host
  arg Str host
  if advancedlocking
    sem rd_request
    hsem request host
  else
    sem request
  if somelocking
    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
  if somelocking
    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