Patch title: Release 93 bulk changes
Abstract:
File: /protocol/ftp/client.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 list name sub options flags files
  arg Str name sub options ; arg Int flags ; arg_rw List fil
  if (name parse "//" any:(var Str server) "/" any:(var Str 
    path := "/"+path
  eif (name parse "/" any:(var Str path))
    server := "localhost" ; path := "/"+path
  else
    return
  var Int port
  if (server eparse any:(var Str server1) ":" port)
    server := server1
  else
    port := 21
  var Str user := options option "user" Str
  var Str password := options option "password" Str
  if not (options option "user")
    user := "anonymous"
  if not (options option "password")
    password := computer_name+"@"+computer_domain
  var CBool eccentric := options option "eccentric"
  var CBool lowercase := options option "lower"
  var Link:FtpConnection ftp :> connect server port user pas
  if not exists:ftp
    return
  if ftp:syst=""
    ftp command "SYST"
    var Str syst := lower ftp:status2
    if syst="200 pliant ftp server version 1.00"
      ftp syst := "Pliant OS/2"
    eif (syst parse word:"200" word:"pliant" word:"ftp" word
      ftp syst := "Pliant"
    eif (syst search "unix" -1)>=0
      ftp syst := "Unix"
    else
      ftp syst := "Unknown"
  ftp command "CWD "+path
  if ftp:status>=400
    return
  var List names info
  ftp open_data_stream
  if not eccentric                     
    ftp command "LIST"+(shunt ftp:syst="Pliant" and (flags .
    ftp connect_data_stream1
    if ftp:status>=400
      ftp close_data_stream
      deconnect ftp
      return
    ftp connect_data_stream2
    while not (ftp:data_stream atend)
      var Str l := ftp:data_stream readline
      ftp:log trace "list " l
      var Str filename dir rights ascii_month opt
      var Intn size ; var DateTime dt1
      var Int year month day hour minute second
      if ftp:syst="Pliant" and (l parse filename size dt1 an
        var Link:FileInfo f :> new FileInfo
        f name := name+filename
        f size := size
        f datetime := dt1
        if ("[dq]"+opt+"[dq]" parse (var Str opt2))
          f options := opt2
# 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 list name sub options flags files
  arg Str name sub options ; arg Int flags ; arg_rw List fil
  if (name parse "//" any:(var Str server) "/" any:(var Str 
    path := "/"+path
  eif (name parse "/" any:(var Str path))
    server := "localhost" ; path := "/"+path
  else
    return
  var Int port
  if (server eparse any:(var Str server1) ":" port)
    server := server1
  else
    port := 21
  var Str user := options option "user" Str
  var Str password := options option "password" Str
  if not (options option "user")
    user := "anonymous"
  if not (options option "password")
    password := computer_name+"@"+computer_domain
  var CBool eccentric := options option "eccentric"
  var CBool lowercase := options option "lower"
  var Link:FtpConnection ftp :> connect server port user pas
  if not exists:ftp
    return
  if ftp:syst=""
    ftp command "SYST"
    var Str syst := lower ftp:status2
    if syst="200 pliant ftp server version 1.00"
      ftp syst := "Pliant OS/2"
    eif (syst parse word:"200" word:"pliant" word:"ftp" word
      ftp syst := "Pliant"
    eif (syst search "unix" -1)>=0
      ftp syst := "Unix"
    else
      ftp syst := "Unknown"
  ftp command "CWD "+path
  if ftp:status>=400
    return
  var List names info
  ftp open_data_stream
  if not eccentric                     
    ftp command "LIST"+(shunt ftp:syst="Pliant" and (flags .
    ftp connect_data_stream1
    if ftp:status>=400
      ftp close_data_stream
      deconnect ftp
      return
    ftp connect_data_stream2
    while not (ftp:data_stream atend)
      var Str l := ftp:data_stream readline
      ftp:log trace "list " l
      var Str filename dir rights ascii_month opt
      var Intn size ; var DateTime dt1
      var Int year month day hour minute second
      if ftp:syst="Pliant" and (l parse filename size dt1 an
        var Link:FileInfo f :> new FileInfo
        f name := name+filename
        f size := size
        f datetime := dt1
        if ("[dq]"+opt+"[dq]" parse (var Str opt2))
          f options := opt2
        f status := success
        files append addressof:f
      if ftp:syst="Unix" and (l parse any:rights _ any _ any
        if filename<>"./" and filename<>"../"
          var Link:FileInfo f :> new FileInfo
          if (filename parse any:(var Str filename1) "->" an
            filename := filename1
            if link:len>0 and (link link:len-1 1)="/"
              filename := filename+"/"
            f options := "link "+string:link
          if filename:len>0 and (filename filename:len-1 1)=
            filename := filename 0 filename:len-1
          f name := name+filename
          f size := size
          month := ("XXX Jan Feb Mar Apr May Jun Jul Aug Sep
          if month>0
            f datetime := datetime year month day hour minut
        files append addressof:f
      if ftp:syst="Unix" and (l parse any:rights _ any _ any
        if filename<>"./" and filename<>"../"
          var Link:FileInfo f :> new FileInfo
          if (filename parse any:(var Str filename1) "->" an
            filename := filename1
            if link:len>0 and (link link:len-1 1)="/"
              filename := filename+"/"
            f options := "link "+string:link
          if filename:len>0 and (filename filename:len-1 1)=
            filename := filename 0 filename:len-1
          f name := name+filename
          f size := size
          month := ("XXX Jan Feb Mar Apr May Jun Jul Aug Sep
          if month>0
            f datetime := datetime year month day hour minut
          f status := success
          files append addressof:f
      eif ftp:syst="Pliant OS/2" and (l parse day "/" month 
        var Link:FileInfo f :> new FileInfo
        if lowercase
          f name := shunt (filename parse word:"DIR" any:dir
        else
          f name := shunt (filename parse word:"DIR" any:dir
        f size := size
        f datetime := datetime year month day hour minute se
          files append addressof:f
      eif ftp:syst="Pliant OS/2" and (l parse day "/" month 
        var Link:FileInfo f :> new FileInfo
        if lowercase
          f name := shunt (filename parse word:"DIR" any:dir
        else
          f name := shunt (filename parse word:"DIR" any:dir
        f size := size
        f datetime := datetime year month day hour minute se
        f status := success
        files append addressof:f
      eif (l parse any:rights _ any _  any _ any _ size _ an
        # Unix ls -l format
        if filename<>"." and filename<>".."
          var Link:FileInfo f :> new FileInfo
          if (filename parse any:(var Str filename1) "->" an
            filename := filename1
            if link:len>0 and (link link:len-1 1)="/"
              filename := filename+"/"
            f options := "link "+string:link
          f name := name+filename+(shunt (rights 0 1)="d" "/
          f size := size
        files append addressof:f
      eif (l parse any:rights _ any _  any _ any _ size _ an
        # Unix ls -l format
        if filename<>"." and filename<>".."
          var Link:FileInfo f :> new FileInfo
          if (filename parse any:(var Str filename1) "->" an
            filename := filename1
            if link:len>0 and (link link:len-1 1)="/"
              filename := filename+"/"
            f options := "link "+string:link
          f name := name+filename+(shunt (rights 0 1)="d" "/
          f size := size
          f status := success
          files append addressof:f
          if not f:is_directory
            names append addressof:(new Str filename)
            info append addressof:f
      else
        ftp:log trace "unsupported listing"
  else
    ftp command "NLST"+(shunt sub<>"" " "+sub "")
    ftp connect_data_stream1
    if ftp:status>=400
      ftp close_data_stream
      deconnect ftp
      return
    ftp connect_data_stream2
    while not (ftp:data_stream atend)
      var Str l := ftp:data_stream readline
      var Link:FileInfo f :> new FileInfo
      f name := name+l
          files append addressof:f
          if not f:is_directory
            names append addressof:(new Str filename)
            info append addressof:f
      else
        ftp:log trace "unsupported listing"
  else
    ftp command "NLST"+(shunt sub<>"" " "+sub "")
    ftp connect_data_stream1
    if ftp:status>=400
      ftp close_data_stream
      deconnect ftp
      return
    ftp connect_data_stream2
    while not (ftp:data_stream atend)
      var Str l := ftp:data_stream readline
      var Link:FileInfo f :> new FileInfo
      f name := name+l
      f status := success
      files append addressof:f
      names append addressof:(new Str filename)
      info append addressof:f
  ftp close_data_stream
  ftp status
  var Pointer:Arrow c1 :> names first
  var Pointer:Arrow c2 :> info first
  while c1<>null
    var Pointer:Str name2 :> c1 map Str
    var Pointer:FileInfo info2 :> c2 map FileInfo
    ftp command "MDTM "+path+name2
    if (ftp:status2 parse (var Int retcode) _ any:(var Str d
      if ((dt 0 4) parse year) and ((dt 4 2) parse month) an
        info2 datetime := datetime year month day hour minut
    if eccentric
      ftp command "SIZE "+path+name2
      if (ftp:status2 parse (var Int retcode) _ size) and re
        info2 size := size
      ftp command "CWD "+path+name2
      if ftp:status<300
        info2 name += "/"
    c1 :> names next c1  
    c2 :> info next c2
  deconnect ftp


      files append addressof:f
      names append addressof:(new Str filename)
      info append addressof:f
  ftp close_data_stream
  ftp status
  var Pointer:Arrow c1 :> names first
  var Pointer:Arrow c2 :> info first
  while c1<>null
    var Pointer:Str name2 :> c1 map Str
    var Pointer:FileInfo info2 :> c2 map FileInfo
    ftp command "MDTM "+path+name2
    if (ftp:status2 parse (var Int retcode) _ any:(var Str d
      if ((dt 0 4) parse year) and ((dt 4 2) parse month) an
        info2 datetime := datetime year month day hour minut
    if eccentric
      ftp command "SIZE "+path+name2
      if (ftp:status2 parse (var Int retcode) _ size) and re
        info2 size := size
      ftp command "CWD "+path+name2
      if ftp:status<300
        info2 name += "/"
    c1 :> names next c1  
    c2 :> info next c2
  deconnect ftp