Patch title: Release 90 bulk changes
Abstract:
File: /appli/file_browser.pli
Key:
    Removed line
    Added line
   
module "/pliant/protocol/http/server.pli"
module "/pliant/protocol/http/style/default.style"
module "/pliant/protocol/common/mime.pli"
module "/pliant/language/context.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/execute.pli"
module "/pliant/util/encoding/http.pli"
module "/pliant/util/encoding/date.pli"
module "/pliant/protocol/http/webdav.pli"
if os_api="linux"
  module "/pliant/language/stream/pipe.pli"



method page browse_directory path options write direct_path
  arg_rw HtmlPage page ; arg Str path options ; arg CBool wr
  implicit page
    if options="delete" and write
      [Are you sure that you want to delete directory] ; fix
      button "yes" noeol
        file_tree_delete path
        goto_backward
      button "no"
        goto_backward
    eif options="list"
      var Array:FileInfo files := file_list path extended+re
      for (var Int i) 0 files:size-1
        html "<pfile name=[dq]"+(html_encode files:i:name)+"
    else
      head "<meta name=[dq]robots[dq] content=[dq]noindex,no
      var CBool detailed := (options option "detailed") and 
      title path
      table columns 2 border 0
        cell [Path:]
        cell (fixed text:path)
      if not detailed and allowed:"administrator"
        link "compute disk usage" "./" options "detailed"
      var Array:FileInfo files := file_list path extended+re
      var Int total_count := 0 ; var Intn total_size := 0 
      table columns (shunt detailed 5 4)
        cell header
          bold [name]
        if detailed
          cell header
            bold [count]
        cell header
          bold [size]
        cell header
          bold [date ]
          note "*"
            title "Pliant date format"
            [The date is displayed using] ; fixed [ ] ; ital
        cell header
          void
        for (var Int i) 0 files:size-1
          var Pointer:FileInfo f :> files i
          html "<pfile name=[dq]"+(html_encode f:name)+"[dq]
          if f:is_directory
            cell
              bold
module "/pliant/protocol/http/server.pli"
module "/pliant/protocol/http/style/default.style"
module "/pliant/protocol/common/mime.pli"
module "/pliant/language/context.pli"
module "/pliant/language/compiler.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/admin/execute.pli"
module "/pliant/util/encoding/http.pli"
module "/pliant/util/encoding/date.pli"
module "/pliant/protocol/http/webdav.pli"
if os_api="linux"
  module "/pliant/language/stream/pipe.pli"



method page browse_directory path options write direct_path
  arg_rw HtmlPage page ; arg Str path options ; arg CBool wr
  implicit page
    if options="delete" and write
      [Are you sure that you want to delete directory] ; fix
      button "yes" noeol
        file_tree_delete path
        goto_backward
      button "no"
        goto_backward
    eif options="list"
      var Array:FileInfo files := file_list path extended+re
      for (var Int i) 0 files:size-1
        html "<pfile name=[dq]"+(html_encode files:i:name)+"
    else
      head "<meta name=[dq]robots[dq] content=[dq]noindex,no
      var CBool detailed := (options option "detailed") and 
      title path
      table columns 2 border 0
        cell [Path:]
        cell (fixed text:path)
      if not detailed and allowed:"administrator"
        link "compute disk usage" "./" options "detailed"
      var Array:FileInfo files := file_list path extended+re
      var Int total_count := 0 ; var Intn total_size := 0 
      table columns (shunt detailed 5 4)
        cell header
          bold [name]
        if detailed
          cell header
            bold [count]
        cell header
          bold [size]
        cell header
          bold [date ]
          note "*"
            title "Pliant date format"
            [The date is displayed using] ; fixed [ ] ; ital
        cell header
          void
        for (var Int i) 0 files:size-1
          var Pointer:FileInfo f :> files i
          html "<pfile name=[dq]"+(html_encode f:name)+"[dq]
          if f:is_directory
            cell
              bold
                link f:name f:name
                link f:name f:name relative no_extension
            if detailed
              path_size path+f:name (var Int count) (var Int
              cell
                italic (text string:count)
              cell
                if (options option "byte")
                  italic (text string:size)
                else
                  italic (text (string size\2^20)+" MB")
              total_count += count ; total_size += size
            else
              cell void
            cell void
            cell
              small
                if (file_list path+f:name standard+directori
            if detailed
              path_size path+f:name (var Int count) (var Int
              cell
                italic (text string:count)
              cell
                if (options option "byte")
                  italic (text string:size)
                else
                  italic (text (string size\2^20)+" MB")
              total_count += count ; total_size += size
            else
              cell void
            cell void
            cell
              small
                if (file_list path+f:name standard+directori
                  link "delete" f:name no_extension options 
                  link "delete" f:name relative no_extension options "delete"
          else
            cell
              if direct_path<>""
          else
            cell
              if direct_path<>""
                link f:name direct_path+f:name no_extension
                link f:name direct_path+f:name relative no_extension
              else
                text f:name
            if detailed
              cell void
            cell
              text (string f:size "separated [dq]"+character
            cell
              text (string f:datetime)
            cell
              small
                var Str mime := query_mime_type f:extension
                if not (mime parse "binary/" any) and not (m
              else
                text f:name
            if detailed
              cell void
            cell
              text (string f:size "separated [dq]"+character
            cell
              text (string f:datetime)
            cell
              small
                var Str mime := query_mime_type f:extension
                if not (mime parse "binary/" any) and not (m
                  link "view" f:name no_extension options "t
                  link "view" f:name relative no_extension options "text" ; fixed [ ]
                  if write
                  if write
                    link "edit" f:name no_extension options 
                link "download" f:name no_extension options 
                    link "edit" f:name relative no_extension options "edit" ; fixed [ ]
                link "download" f:name relative no_extension options "binary" ; fixed [ ] 
                if write
                if write
                  link "copy" f:name no_extension options "c
                  link "delete" f:name no_extension options 
                  link "copy" f:name relative no_extension options "copy" ; fixed [ ] 
                  link "delete" f:name relative no_extension options "delete"
            total_count += 1 ; total_size += f size
        if detailed
          cell header
            [total]
          cell
            italic (text string:total_count)
          cell
            if (options option "byte")
              italic (text string:total_size)
            else
              italic (text (string total_size\2^20)+" MB")
          cell void
          cell void
      if write
        if os_api="linux" and allowed:"administrator"
          input "" (var Str subdirs) noeol
          note "*"
            [Leave the field blank if you want to download t
          page button ".tgz download"
            stream_pipe (var Str in_pipe_name) (var Str out_
            thread
              execute "tar -zc "+(shunt subdirs<>"" subdirs 
            (var Stream tgz) open in_pipe_name in+safe
            reset_http_answer
            http_request send_header "mime [dq]binary/*[dq]"
            while not tgz:atend and http_request:answer_stre
              raw_copy tgz http_request:answer_stream 1 2^16
            http_request send_footer
        file_upload "" (var Str filename) noeol
        button "Upload" noeol
          if (file_query filename standard)=defined
            var Str remote := filename option "remote_name" 
            if remote<>""
              apply_uploaded_file filename path+remote ""
              reload_page
            else
              [I have not received the file name !]
          else
            [I have not received the file !]
            para
              [The explaination might be that your browser d
              [If you wonder what browsers supports uploadin
        if os_api="linux" and allowed:"administrator"
          page button ".tgz upload" noeol
            var Str tgz := replace file_temporary ".tmp" ".t
            file_move filename tgz
            file_extract tgz path
            file_delete tgz
            reload_page
        eol
        input "" (var Str filename2) noeol
        button "Create file" noeol
          (var Stream s) open path+filename2 out+safe ; s cl
          reload_page
        button "Create directory"
          file_tree_create path+filename2+"/"
          reload_page
        # input "Target computer: " (var Str target) noeol
        # input "Password: " (var Str passwd) password noeol
        # button "Synchronize"
        #   void
        if allowed:"administrator"
          page button "Delete directory"
            title "Delete "+path+" directory"
            para
              [Here is the list of the files you are going t
              var Array:FileInfo files2 := file_list path st
              var Intn total := 0
              for (var Int i) 0 files2:size-1
                fixed (text files2:i:name) ; eol
                total += files2:i size
              text "That's "+(string files2:size)+" files co
            para
              [Are you sure that you want to recursively del
              fixed (text " "+path+" ")
              [?]
            para
              button "yes" noeol
                file_tree_delete path
                goto_backward
              button "no"
                goto_backward
      table columns 1
        cell
          table columns 2 border 0
            cell
              input "Name pattern: " (var Str name_pattern)
              if allowed:"administrator"
                input "Content pattern: " (var Str content_p
                select "Case sensitive: " (var Str case_sens
                  option "no" ""
                  option "yes" "yes"
            cell
              button "Search"
                title "Files search report"
                table columns 2 border 0
                  cell [Path:]
                  cell (fixed text:path)
                  if name_pattern<>""
                    cell [Name pattern:]
                    cell (fixed text:name_pattern)
                  if content_pattern<>""
                    cell [Content pattern:]
                    cell (fixed text:content_pattern)
                var Array:FileInfo all_files := file_list pa
                var CBool case := case_sensitive="yes"
                if content_pattern<>"" and allowed:"administ
                  table columns 2
                    for (var Int i) 0 all_files:size-1
                      if name_pattern="" or (all_files:i:nam
                        (var Stream s) open path+all_files:i
                        while not s:atend
                          var Str l := s readline
                          var CBool matching
                          if case
                            matching := (l search content_pa
                          else
                            matching := (upper:l search uppe
                          if matching
                            cell
            total_count += 1 ; total_size += f size
        if detailed
          cell header
            [total]
          cell
            italic (text string:total_count)
          cell
            if (options option "byte")
              italic (text string:total_size)
            else
              italic (text (string total_size\2^20)+" MB")
          cell void
          cell void
      if write
        if os_api="linux" and allowed:"administrator"
          input "" (var Str subdirs) noeol
          note "*"
            [Leave the field blank if you want to download t
          page button ".tgz download"
            stream_pipe (var Str in_pipe_name) (var Str out_
            thread
              execute "tar -zc "+(shunt subdirs<>"" subdirs 
            (var Stream tgz) open in_pipe_name in+safe
            reset_http_answer
            http_request send_header "mime [dq]binary/*[dq]"
            while not tgz:atend and http_request:answer_stre
              raw_copy tgz http_request:answer_stream 1 2^16
            http_request send_footer
        file_upload "" (var Str filename) noeol
        button "Upload" noeol
          if (file_query filename standard)=defined
            var Str remote := filename option "remote_name" 
            if remote<>""
              apply_uploaded_file filename path+remote ""
              reload_page
            else
              [I have not received the file name !]
          else
            [I have not received the file !]
            para
              [The explaination might be that your browser d
              [If you wonder what browsers supports uploadin
        if os_api="linux" and allowed:"administrator"
          page button ".tgz upload" noeol
            var Str tgz := replace file_temporary ".tmp" ".t
            file_move filename tgz
            file_extract tgz path
            file_delete tgz
            reload_page
        eol
        input "" (var Str filename2) noeol
        button "Create file" noeol
          (var Stream s) open path+filename2 out+safe ; s cl
          reload_page
        button "Create directory"
          file_tree_create path+filename2+"/"
          reload_page
        # input "Target computer: " (var Str target) noeol
        # input "Password: " (var Str passwd) password noeol
        # button "Synchronize"
        #   void
        if allowed:"administrator"
          page button "Delete directory"
            title "Delete "+path+" directory"
            para
              [Here is the list of the files you are going t
              var Array:FileInfo files2 := file_list path st
              var Intn total := 0
              for (var Int i) 0 files2:size-1
                fixed (text files2:i:name) ; eol
                total += files2:i size
              text "That's "+(string files2:size)+" files co
            para
              [Are you sure that you want to recursively del
              fixed (text " "+path+" ")
              [?]
            para
              button "yes" noeol
                file_tree_delete path
                goto_backward
              button "no"
                goto_backward
      table columns 1
        cell
          table columns 2 border 0
            cell
              input "Name pattern: " (var Str name_pattern)
              if allowed:"administrator"
                input "Content pattern: " (var Str content_p
                select "Case sensitive: " (var Str case_sens
                  option "no" ""
                  option "yes" "yes"
            cell
              button "Search"
                title "Files search report"
                table columns 2 border 0
                  cell [Path:]
                  cell (fixed text:path)
                  if name_pattern<>""
                    cell [Name pattern:]
                    cell (fixed text:name_pattern)
                  if content_pattern<>""
                    cell [Content pattern:]
                    cell (fixed text:content_pattern)
                var Array:FileInfo all_files := file_list pa
                var CBool case := case_sensitive="yes"
                if content_pattern<>"" and allowed:"administ
                  table columns 2
                    for (var Int i) 0 all_files:size-1
                      if name_pattern="" or (all_files:i:nam
                        (var Stream s) open path+all_files:i
                        while not s:atend
                          var Str l := s readline
                          var CBool matching
                          if case
                            matching := (l search content_pa
                          else
                            matching := (upper:l search uppe
                          if matching
                            cell
                              link all_files:i:name all_file
                              link all_files:i:name all_files:i:path relative no_extension
                            cell
                              small
                                fixed text:l ; eol
                                while not s:atend
                                  var Str l := s readline
                                  if case
                                    matching := (l search co
                                  else
                                    matching := (upper:l sea
                                  if matching
                                    fixed text:l ; eol
                else
                  for (var Int i) 0 all_files:size-1
                    if name_pattern="" or (all_files:i:name_
                            cell
                              small
                                fixed text:l ; eol
                                while not s:atend
                                  var Str l := s readline
                                  if case
                                    matching := (l search co
                                  else
                                    matching := (upper:l sea
                                  if matching
                                    fixed text:l ; eol
                else
                  for (var Int i) 0 all_files:size-1
                    if name_pattern="" or (all_files:i:name_
                      link all_files:i:name all_files:i:path
                      link all_files:i:name all_files:i:path relative no_extension ; eol



method page file_browser path options write direct_path
  arg_rw HtmlPage page ; arg Str path options ; arg CBool wr
  implicit page
    var Str answer := ""
    if virtual_command="GET" or virtual_command="POST"
      if path:len>0 and (path path:len-1)="/"
        browse_directory path options write direct_path
      else
        browse_file path options write
    eif virtual_command="HEAD"
      var FileInfo info := file_query path extended
      if info=success
        reset_http_answer
        if not info:is_directory
          http_request answer_size := info size
          http_request answer_datetime := info datetime
        http_request answer_is_dynamic := false
        http_request send_header
        http_request send_footer
      else
        answer := "404 Not found"
    eif virtual_command="PUT"
      if not write
        reset_http_answer
        http_request send_authentification_request
        return
      var DateTime dt := undefined
      var Str opt := ""
      var Pointer:Arrow c :> http_request:query_log first
      while c<>null
        var Pointer:Str s :> c map Str
        if (s parse acword:"pliant-options" ":" any:(var Str
          opt := http_decode value
        eif (s parse acword:"last-modified" ":" any:(var Str
          dt := rfc1123_date value
        c :> http_request:query_log next c
      var Str temp := file_temporary
      reset_http_answer
      (var Stream data) open temp out+safe
      var Int bytes := 0
      while not http_request:query_stream:atend and data=suc
        bytes += raw_copy http_request:query_stream data 1 2
      data close
      if dt=defined
        file_configure temp "datetime "+string:dt
      answer := shunt (apply_uploaded_file temp path opt)=su
      file_delete temp
    eif virtual_command="OPTIONS"
      answer := "200 OK"
      http_request:answer_extra append addressof:(new Str "A
      http_request:answer_extra append addressof:(new Str "D
    eif virtual_command="PROPFIND"
      var FileInfo info := file_query path extended
      var Array:FileInfo dir
      if http_request:webdav_depth<>0
        dir := file_list info:name extended+directories+rela
      webdav_propfind info dir
    eif virtual_command="PROPPATCH" or virtual_command="LOCK
      answer := "200 OK"
    eif virtual_command="MKCOL"
      if not write
        reset_http_answer
        http_request send_authentification_request
        return
      var Str slash := shunt path:len=0 or (path path:len-1)
      answer := shunt (file_tree_create path+slash)=success 
    eif virtual_command="MOVE"
      answer := "403 Forbidden"
      var Str src := "http://"+http_request:site_name+http_r
      var Str dest := ""
      var Pointer:Arrow c :> http_request:query_log first
      while c<>null
        if ((c map Str) parse acword:"Destination" ":" any:(



method page file_browser path options write direct_path
  arg_rw HtmlPage page ; arg Str path options ; arg CBool wr
  implicit page
    var Str answer := ""
    if virtual_command="GET" or virtual_command="POST"
      if path:len>0 and (path path:len-1)="/"
        browse_directory path options write direct_path
      else
        browse_file path options write
    eif virtual_command="HEAD"
      var FileInfo info := file_query path extended
      if info=success
        reset_http_answer
        if not info:is_directory
          http_request answer_size := info size
          http_request answer_datetime := info datetime
        http_request answer_is_dynamic := false
        http_request send_header
        http_request send_footer
      else
        answer := "404 Not found"
    eif virtual_command="PUT"
      if not write
        reset_http_answer
        http_request send_authentification_request
        return
      var DateTime dt := undefined
      var Str opt := ""
      var Pointer:Arrow c :> http_request:query_log first
      while c<>null
        var Pointer:Str s :> c map Str
        if (s parse acword:"pliant-options" ":" any:(var Str
          opt := http_decode value
        eif (s parse acword:"last-modified" ":" any:(var Str
          dt := rfc1123_date value
        c :> http_request:query_log next c
      var Str temp := file_temporary
      reset_http_answer
      (var Stream data) open temp out+safe
      var Int bytes := 0
      while not http_request:query_stream:atend and data=suc
        bytes += raw_copy http_request:query_stream data 1 2
      data close
      if dt=defined
        file_configure temp "datetime "+string:dt
      answer := shunt (apply_uploaded_file temp path opt)=su
      file_delete temp
    eif virtual_command="OPTIONS"
      answer := "200 OK"
      http_request:answer_extra append addressof:(new Str "A
      http_request:answer_extra append addressof:(new Str "D
    eif virtual_command="PROPFIND"
      var FileInfo info := file_query path extended
      var Array:FileInfo dir
      if http_request:webdav_depth<>0
        dir := file_list info:name extended+directories+rela
      webdav_propfind info dir
    eif virtual_command="PROPPATCH" or virtual_command="LOCK
      answer := "200 OK"
    eif virtual_command="MKCOL"
      if not write
        reset_http_answer
        http_request send_authentification_request
        return
      var Str slash := shunt path:len=0 or (path path:len-1)
      answer := shunt (file_tree_create path+slash)=success 
    eif virtual_command="MOVE"
      answer := "403 Forbidden"
      var Str src := "http://"+http_request:site_name+http_r
      var Str dest := ""
      var Pointer:Arrow c :> http_request:query_log first
      while c<>null
        if ((c map Str) parse acword:"Destination" ":" any:(
          dest := value
          dest := http_decode value
        c :> http_request:query_log next c
      if (dest 0 (dest search_last "/" dest:len)+1)=(src 0 (
        var Status status := file_move path (path 0 (path se
        if status=success
          answer := "200 OK"
    eif virtual_command="DELETE"
      if not write
        reset_http_answer
        http_request send_authentification_request
        return
      answer := shunt file_delete:path=success or (file_tree
    else
      answer := "501 Not implemented"
    if answer<>""
      reset_http_answer
      http_request send_header "status "+string:answer+" siz
      http_request send_footer

export '. apply_uploaded_file' '. file_browser'
        c :> http_request:query_log next c
      if (dest 0 (dest search_last "/" dest:len)+1)=(src 0 (
        var Status status := file_move path (path 0 (path se
        if status=success
          answer := "200 OK"
    eif virtual_command="DELETE"
      if not write
        reset_http_answer
        http_request send_authentification_request
        return
      answer := shunt file_delete:path=success or (file_tree
    else
      answer := "501 Not implemented"
    if answer<>""
      reset_http_answer
      http_request send_header "status "+string:answer+" siz
      http_request send_footer

export '. apply_uploaded_file' '. file_browser'