Patch title: Release 94 bulk changes
Abstract:
File: /pliant/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"


plugin timeout
  constant tar_timeout 3600 # the downgrade.tgz should be packed in less than xxx seconds
  constant upgrade_timeout 7200 # the downgrade.tgz should have been remotely removed in less than xxx seconds


module "/pliant/fullpliant/this_computer.pli"
constant fullpliant this_computer:env:"pliant":"system":"distribution"="fullpliant"
if os_api="linux"
  module "/pliant/linux/kernel/shutdown.pli"
if fullpliant
  module "/pliant/fullpliant/shutdown.pli"


module "/pliant/appli/database.pli"
module "/pliant/storage/database.pli"

method page apply_uploaded_file src dest fileoptions0 -> status
  arg_rw HtmlPage page ; arg Str src dest fileoptions0 ; arg Status status
  var Str ext := dest (dest search "." dest:len) dest:len
  if ext=".pdb" and (data_file_switch src dest)=success
    return success
  if fullpliant and ext=".tgz" and file_os_name:dest=file_os_name:"file:/boot/upgrade.tgz"
    file_delete "file:/boot/downgrade.tgz"  
    execute "pliant module /pliant/install/minimal.pli module /pliant/fullpliant/recover.pli command 'downgrade "+string:upgrade_timeout+"'" detached
    var Float remain := tar_timeout
    while remain>0 and (file_query "file:/boot/downgrade.tgz" standard)=undefined
      sleep 1
    if remain>0
      var Array:FileInfo files := file_list "file:/pliant/binary/" standard
      for (var Int i) 0 files:size-1
        if files:i:extension=".dump"
          file_delete files:i:name
      file_move src dest
      file_extract dest "file:/"
      file_delete dest
      page shutdown 120 "restart"
  eif fullpliant and ext=".tgz" and file_os_name:dest=file_os_name:"file:/boot/pliant.tgz"
    var Array:FileInfo files := file_list "file:/pliant/binary/" standard
    for (var Int i) 0 files:size-1
      if files:i:extension=".dump"
        file_delete files:i:name
    file_move src dest
    file_extract dest "file:/"
    file_delete dest
    page shutdown 120 "restart"
  eif fullpliant and os_api="linux" and ext=".tgz" and (file_os_name:dest=file_os_name:"file:/boot/fullpliant.tgz" or file_os_name:dest=file_os_name:"file:/boot/kernel.tgz")
  eif fullpliant and os_api="linux" and ext=".tgz" and (file_os_name:dest=file_os_name:"file:/boot/fullpliant.tgz" or file_os_name:dest=file_os_name:"file:/boot/kernel.tgz" or file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz")
    var Array:FileInfo files := file_list "file:/pliant/binary/" standard
    for (var Int i) 0 files:size-1
      if files:i:extension=".dump"
        file_delete files:i:name
    file_move src dest
    page shutdown 120 ""
    file_move "security:/" "file:/pliant_security.backup/"
    if file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz"
      file_move "file:/boot/kernel" "file:/boot/fullpliant"
    file_extract dest "file:/"
    if file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz"
      file_move "file:/boot/kernel" "file:/boot/once"
      file_move "file:/boot/fullpliant" "file:/boot/kernel"
    file_tree_delete "security:/"
    file_move "file:/pliant_security.backup/" "security:/"
    pliant_load_module "/pliant/appli/file_browser/lilo.pli" the_module:"/pliant/language/basic/safe.pli" 0 (null map Module)
    if file_os_name:dest=file_os_name:"file:/boot/kernel.tgz"
    if file_os_name:dest=file_os_name:"file:/boot/kernel.tgz" or file_os_name:dest=file_os_name:"file:/boot/kernel_once.tgz"
      file_tree_delete "file:/sbin/"
      file_tree_delete "file:/etc/"
      file_tree_delete "file:/usr/"
      file_tree_delete "file:/var/"
      file_delete "file:/boot/modules.tgz"
      file_move dest "file:/boot/modules.tgz"
      if file_os_name:dest=file_os_name:"file:/boot/kernel.tgz"
        file_move dest "file:/boot/modules.tgz"
      else
        file_delete dest
    else
      file_delete dest
    kernel_shutdown true
  var Str fileoptions := shunt fileoptions0<>"" fileoptions0 (file_query dest extended):options
  status := file_move src dest
  if status=failure
    file_delete dest
    status := file_move src dest
  file_configure dest fileoptions


function rec_path_size path count size
  arg Str path ; arg_rw Int count ; arg_rw Intn size
  var Array:FileInfo files := file_list path extended+directories
  for (var Int i) 0 files:size-1
    if files:i:is_link
      void
    eif files:i:is_directory
      rec_path_size files:i:name count size
    else
      count += 1 ; size += files:i size

function path_size path count size
  arg Str path ; arg_w Int count ; arg_w Intn size
  count := 0 ; size := 0
  rec_path_size path count size

method page browse_directory path options write direct_path
  arg_rw HtmlPage page ; arg Str path options ; arg CBool write ; arg Str direct_path
  implicit page
    if options="delete" and write
      [Are you sure that you want to delete directory] ; fixed:(text " "+path) ; eol
      button "yes" noeol
        file_tree_delete path
        goto_backward
      button "no"
        goto_backward
    eif options="list"
      var Array:FileInfo files := file_list path extended+relative+directories
      for (var Int i) 0 files:size-1
        html "<pfile name=[dq]"+(html_encode files:i:name)+"[dq] size=[dq]"+(string files:i:size)+"[dq] date=[dq]"+(string files:i:datetime)+"[dq] options=[dq]"+(html_encode files:i:options)+"[dq] />[lf]"
    else
      head "<meta name=[dq]robots[dq] content=[dq]noindex,nofollow[dq]>[lf]"
      var CBool detailed := (options option "detailed") and allowed:"administrator"
      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+relative+directories+sorted
      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 [ ] ; italic [year] ; [/] ; italic [month] ; [/] ; italic [day] ; [ ] ; italic [hour] ; [:] ; italic [minute] ; [:] ; italic [second] ; fixed [ ] ; [format.]
        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] size=[dq]"+(string f:size)+"[dq] date=[dq]"+(string f:datetime)+"[dq] options=[dq]"+(html_encode f:options)+"[dq] />[lf]"
          if f:is_directory
            cell
              bold
                link f:name f:name relative no_extension
            if detailed
              path_size path+f:name (var Int count) (var Intn size)
              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+directories):size=0 and write
                  link "delete" f:name relative no_extension options "delete"
          else
            cell
              if direct_path<>""
                link f:name direct_path+f:name relative no_extension
              eif (query_mime_type f:extension)<>""
                link f:name f:name relative no_extension
              else
                text f:name
            if detailed
              cell void
            cell
              text (string f:size "separated [dq]"+character:183+"[dq]")
            cell
              text (string f:datetime)
            cell
              small
                var Str mime := query_mime_type f:extension
                if not (mime parse "binary/" any) and not (mime parse "image/" any)
                  link "view" f:name relative no_extension options "text" ; fixed [ ]
                  if write
                    link "edit" f:name relative no_extension options "edit" ; fixed [ ]
                link "download" f:name relative no_extension options "binary" ; fixed [ ] 
                if write
                  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 the all directory content.]
          page button ".tgz download"
            stream_pipe (var Str in_pipe_name) (var Str out_pipe_name)
            thread
              execute "tar -zc "+(shunt subdirs<>"" subdirs ".") path path output out_pipe_name
            (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_stream=success
              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" Str
            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 does not support uploading because it cannot send multipart forms.] ; eol
              [If you wonder what browsers supports uploading, then all I can tel you is that Nestcape 4 and Mozilla do.]
        if os_api="linux" and allowed:"administrator"
          page button ".tgz upload" noeol
            var Str tgz := replace file_temporary ".tmp" ".tgz"
            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 close
          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 to delete:] ; eol
              var Array:FileInfo files2 := file_list path standard+recursive+sorted
              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 containing "+(string total\2^20)+" MB of datas."
            para
              [Are you sure that you want to recursively delete all files in]
              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_pattern) noeol
                select "Case sensitive: " (var Str case_sensitive)
                  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 path standard+relative+directories+recursive+sorted
                var CBool case := case_sensitive="yes"
                if content_pattern<>"" and allowed:"administrator"
                  table columns 2
                    for (var Int i) 0 all_files:size-1
                      if name_pattern="" or (all_files:i:name_without_path search name_pattern -1)<>(-1)
                        (var Stream s) open path+all_files:i:name in+safe
                        while not s:atend
                          var Str l := s readline
                          var CBool matching
                          if case
                            matching := (l search content_pattern -1)<>(-1)
                          else
                            matching := (upper:l search upper:content_pattern -1)<>(-1)
                          if matching
                            cell
                              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 content_pattern -1)<>(-1)
                                  else
                                    matching := (upper:l search upper:content_pattern -1)<>(-1)
                                  if matching
                                    fixed text:l ; eol
                else
                  for (var Int i) 0 all_files:size-1
                    if name_pattern="" or (all_files:i:name_without_path search name_pattern -1)<>(-1)
                      link all_files:i:name all_files:i:path relative no_extension ; eol


method page browse_file path options write
  arg_rw HtmlPage page ; arg Str path options ; arg CBool write
  implicit page
    if options="text"
      reset_http_answer
      http_request send_static_file path "mime [dq]text/plain[dq]"
    eif options="binary"
      reset_http_answer
      http_request send_static_file path "mime [dq]binary/*[dq]"
    eif options="edit" and write
      small
        bold text:path
        var FileInfo info := file_query path extended
        if info:link<>""
          text " -> "+info:link
        html (repeat 5 "&nbsp;")
        text (string info:size)+" bytes last modifyed on "+(string info:datetime)
        eol
      var Str all := ""
      (var Stream s1) open path in+safe
      while not s1:atend
        all += s1:readline+"[lf]"
      text_input "" all columns 80 rows 35
      button "Update "+(path (path search_last "/" -1)+1 path:len)
        (var Stream s2) open path out+safe
        s2 writechars all
        goto_backward
    eif options="copy" and write
      [Move ] ; fixed:(text " "+path+" ")
      input " to: " (var Str to)
      button "Copy" noeol
        var Str dest := to
        if (dest 0 1)<>"/" and (dest search ":" -1)=(-1)
          dest := (path 0 (path search_last "/" -1)+1)+dest
        else
          requires "administrator"
        if (reverse:dest 0 1)="/"
          dest += path (path search_last "/" path:len)+1 path:len
        file_copy path dest
        goto_backward
      button "Move" noeol
        var Str dest := to
        if (dest 0 1)<>"/" and (dest search ":" -1)=(-1)
          dest := (path 0 (path search_last "/" -1)+1)+dest
        else
          requires "administrator"
        if (reverse:dest 0 1)="/"
          dest += path (path search_last "/" path:len)+1 path:len
        file_move path dest
        goto_backward
      button "Cancel"
        goto_backward
    eif options="delete" and write
      [Are you sure that you want to delete file] ; fixed:(text " "+path) ; eol
      button "yes" noeol
        file_delete path
        goto_backward
      button "no"
        goto_backward
    else
      reset_http_answer
      http_request send_static_file path ""


method page file_browser path options write direct_path
  arg_rw HtmlPage page ; arg Str path options ; arg CBool write ; arg Str direct_path
  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 value))
          opt := http_decode value
        eif (s parse acword:"last-modified" ":" any:(var Str value))
          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=success
        bytes += raw_copy http_request:query_stream data 1 2^24
      data close
      if dt=defined
        file_configure temp "datetime "+string:dt
      answer := shunt (apply_uploaded_file temp path opt)=success "200 OK" "500 Could not write file"
      file_delete temp
    eif virtual_command="OPTIONS"
      answer := "200 OK"
      http_request:answer_extra append addressof:(new Str "Allow: OPTIONS, PROPFIND, MKCOL")
      http_request:answer_extra append addressof:(new Str "DAV: 1,2")
    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+relative+sorted
      webdav_propfind info dir
    eif virtual_command="PROPPATCH" or virtual_command="LOCK" or virtual_command="UNLOCK"
      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 "201 Created" "500 Could not create directory"
    eif virtual_command="MOVE"
      answer := "403 Forbidden"
      var Str src := "http://"+http_request:site_name+http_request:encoded_path
      var Str dest := ""
      var Pointer:Arrow c :> http_request:query_log first
      while c<>null
        if ((c map Str) parse acword:"Destination" ":" any:(var Str value))
          dest := value
        c :> http_request:query_log next c
      if (dest eparse "http://" any:(var Str dest_site) ":" (var Int dest_port) "/" any:(var Str dest_path)) and (dest_site search "/" -1)=(-1)
        dest := "http://"+dest_site+"/"+dest_path
      if (dest 0 (dest search_last "/" dest:len)+1)=(src 0 (src search_last "/" src:len)+1)
        var Status status := file_move path (path 0 (path search_last "/" path:len)+1)+http_decode:(dest (dest search_last "/" dest:len)+1 dest:len)
        if status=success
          answer := "201 Created"
    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_delete path+"/")=success "200 OK" "404 No such file"
    else
      answer := "501 Not implemented"
    if answer<>""
      reset_http_answer
      http_request send_header "status "+string:answer+" size 0 static"
      http_request send_footer

export '. apply_uploaded_file' '. file_browser'