Patch title: Release 87 bulk changes
Abstract:
File: /pliant/protocol/ftp/server.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 


method env try_site site -> status
  arg_rw FtpEnv env ; arg Data:Site site ; arg Status status
  if not exists:site
    return failure
  if site:computer<>computer_fullname and site:computer<>""
    return failure
# 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 


method env try_site site -> status
  arg_rw FtpEnv env ; arg Data:Site site ; arg Status status
  if not exists:site
    return failure
  if site:computer<>computer_fullname and site:computer<>""
    return failure
  if site:protocol<>"FTP"
    return failure
  var Str ip := env:command query "local_ip_address"
  if ip<>"" and site:ip<>ip and site:ip<>""
    return failure
  if ((env:command query "local_ip_port") parse (var Int por
    return failure
  var Str ip := env:command query "local_ip_address"
  if ip<>"" and site:ip<>ip and site:ip<>""
    return failure
  if ((env:command query "local_ip_port") parse (var Int por
    return failure
  if site:protocol<>"" and site:protocol<>"FTP"
    return failure
  env:log trace "site is " keyof:site
  env site :> site
  status := success


method env allowed path1 write filename -> allow
  arg FtpEnv env ; arg Str path1 ; arg CBool write ; arg_w S
  var Data:SiteArea area
  var Str path := shunt (path1 0 1)="/" path1 env:cwd+path1
  var Str ext := path
  ext := ext (ext search_last "/" -1)+1 ext:len
  ext := ext (ext search_last "." ext:len) ext:len
  var Int longuest := 0
  each a env:site:area
  env:log trace "site is " keyof:site
  env site :> site
  status := success


method env allowed path1 write filename -> allow
  arg FtpEnv env ; arg Str path1 ; arg CBool write ; arg_w S
  var Data:SiteArea area
  var Str path := shunt (path1 0 1)="/" path1 env:cwd+path1
  var Str ext := path
  ext := ext (ext search_last "/" -1)+1 ext:len
  ext := ext (ext search_last "." ext:len) ext:len
  var Int longuest := 0
  each a env:site:area
    var Str p := a path ; var Str e := a extension
    if (path 0 p:len)=p and (e=ext or e="")
      var Int l := p:len+(shunt e=ext 10^9 0)
    var Str p := a path
    if (path 0 p:len)=p
      var Int l := p len
      if l>longuest
        area :> a
        longuest := l
      eif l=longuest
        area :> var Data:SiteArea nonexisting_area
  if area:root=""
    filename := env:site:root+(path 1 path:len)
  else
    filename := area:root+(path area:path:len path:len)
  var Str cond := shunt write area:write area:read
  allow := cond<>"" and (env:rights first cond)<>null or (en



      if l>longuest
        area :> a
        longuest := l
      eif l=longuest
        area :> var Data:SiteArea nonexisting_area
  if area:root=""
    filename := env:site:root+(path 1 path:len)
  else
    filename := area:root+(path area:path:len path:len)
  var Str cond := shunt write area:write area:read
  allow := cond<>"" and (env:rights first cond)<>null or (en