Patch title: Release 94 bulk changes
Abstract:
File: /pliant/graphic/browser/sample/status.pli
Key:
    Removed line
    Added line
   
module "/pliant/language/unsafe.pli"
module "/pliant/language/context.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/graphic/browser/server/context.pli"
module "/pliant/graphic/browser/server/api.pli"
module "/pliant/util/pml/multiplexer.pli"
module "/pliant/protocol/common/tcp_server.pli"
module "/pliant/language/os/process.pli"
if os_api="linux"
  module "/pliant/linux/kernel/module.pli"
  module "/pliant/linux/kernel/statistics.pli"
  module "/pliant/linux/storage/filesystem.pli"
  module "/pliant/language/os/socket.pli"
  module "/pliant/linux/kernel/shutdown.pli"

if os_api="linux"
  method context cat filename timeout
    arg_rw BrowserServerContext context ; arg Str filename ; arg Float timeout
    implicit context
      (var Stream cf) open filename in+safe
      if cf=success
        header filename
        style (text wrap false)
          fixed
            while (timeout=undefined or (os_socket_wait cf:stream_handle 1 timeout)=success) and not cf:atend
              cf read_available (var Address adr) (var Int size)
              (var Str t) set adr size false
              text t
  method context cat filename
    arg_rw BrowserServerContext context ; arg Str filename
    context cat filename undefined

method context status_sumary
  arg_rw BrowserServerContext context
  implicit context
    title "Status - sumary"
    header "Time"
    text "Current time is "+(string datetime) ; eol
    text "Pliant server was started on "+(string multiplexer_running_since)+" (that's "
    bold
      text (string datetime:date:days-multiplexer_running_since:date:days)
    text " days ago)" ; eol
    if os_api="linux"
      (var Stream uptime) open "file:/proc/uptime" in+safe
      if (uptime:readline parse (var Float seconds) any)
        var DateTime boot := datetime ; boot seconds -= seconds
        text "The computer was booted on "+string:boot+" (that's "
        text (string datetime:date:days-boot:date:days)
        text " days ago)" ; eol
    if false
      title "Pliant compiler log"
      fixed
        var Pointer:Arrow c :> compile_log_report first
        while c<>null
          text (c map Str) ; eol  
          c :> compile_log_report next c
    header "Load"
    var Float running_seconds := datetime:seconds-multiplexer_running_since:seconds
    table
      row
        cell
          void
        cell header
          text "1 mn"
        cell header
          text "1 hour"
        cell header
          text "1 day"
      row
        cell header
          text "CPU"
        for (var Int lap) 0 2
          cell
            if os_api="linux" and running_seconds>=(shunt lap=0 0 lap=1 3600\2 86400\2)
              text string:(cast cpu_statistics:(shunt lap=0 60 lap=1 3600 86400)*100 Int)+"%"
              if lap=0
                (var Stream proc) open "file:/proc/loadavg" in+safe
                if (proc:readline parse (var Float l1) (var Float l2) (var Float l3) any)
                  style (text scale 8/72*25.4)
                    text " ("+(string l1*100)+"%)"
            eif lap=0
              text "Not available under "+os_kernel
      row
        cell header
          text "Memory"
        cell
          if os_api="linux"
            (var Stream proc) open "file:/proc/meminfo" in+safe
            var Int total := 0 ; var Int free := 0 ; var Int buffers := 0 ; var Int cached := 0
            var Int swap_total := 0 ; var Int swap_free := 0
            while not proc:atend
              var Str l := proc readline
              l parse "MemTotal" ":" total any
              l parse "MemFree" ":" free any
              l parse "Buffers" ":" buffers any
              l parse "Cached" ":" cached any
            if os_api="linux" and  total<>0 and free<>0
              var Intn memory_total := total*2n^10
              var Int extra := max buffers+cached-16*2^10 0
              var Intn memory_free := (free+extra)*2n^10
              text (string 100n*(memory_total-memory_free)\memory_total)+"%"
            eif memory_physical<>0
              text (string 100n*memory_current_consumed\memory_physical)+"%"
          eif os_api="win32"
            os_GlobalMemoryStatus (var os_MEMORYSTATUS ms)
            text (string ms:dwMemoryLoad)+"%"
          eif memory_physical<>0
            text (string 100n*memory_current_consumed\memory_physical)+"%"
          else
            text "Not available under "+os_kernel
        cell
          void
        cell
          void
      row
        cell header
          text "Disk"
        for (var Int lap) 0 2
          cell
            if os_api="linux"
              if lap=0
                var DiskInfo disk := filesystem_query "file:/"
                text (string 100n*(disk:size-disk:available)\disk:size)+"%"
                (var Stream proc) open "file:/proc/mdstat" in+safe
                var CBool raid := false ; var CBool ok := true
                while not proc:atend
                  var Str l := proc readline
                  if (reverse:l parse any "[rb]" any:(var Str disks) "[lb]" "[rb]" any "/" any "[lb]" any)
                    raid := true
                    if disks<>(repeat disks:len "U")
                      ok := false
                if raid
                  fixed
                    text "   "
                  if ok
                    style (text scale 8/72*25.4)
                      text "RAID is ok"
                  else
                    style (text color (color rgb 255 0 0) bold true scale 8/72*25.4)
                      text "RAID alarm"
                fixed
                  text "   "
              if running_seconds>=(shunt lap=0 0 lap=1 3600\2 86400\2)
                disk_statistics "" (shunt lap=0 60 lap=1 3600 86400) (var Float read_bps) (var Float write_bps)
                text string:(cast read_bps/8/1024 Int)+" KB/s read + "+string:(cast write_bps/8/1024 Int)+" KB/s write"
            eif lap=0
              text "Not available under "+os_kernel
      row
        cell header
          text "Network"
        for (var Int lap) 0 2
          cell
            if os_api="linux" and running_seconds>=(shunt lap=0 0 lap=1 3600\2 86400\2)
              net_statistics "" (shunt lap=0 60 lap=1 3600 86400) (var Float in_bps) (var Float out_bps)
              text string:(cast in_bps/1024 Int)+" Kbps in + "+string:(cast out_bps/1024 Int)+" Kbps out"
            eif lap=0
              text "Not available under "+os_kernel
      if os_api="linux"
        row
          cell header
            text "Hardware"
          for (var Int lap) 0 2
            cell
              if running_seconds>=(shunt lap=0 0 lap=1 3600\2 86400\2)
                var Float ips := interrupts_statistics (shunt lap=0 60 lap=1 3600 86400)
                text (string ips "fixed 0")+" interrupts/s"

method context status_disk
  arg_rw BrowserServerContext context
  implicit context
    var Float running_seconds := datetime:seconds-multiplexer_running_since:seconds
    title "Status - disks"
    header "Disk IO statistics"
    table
      row
        cell header
          text "Device"
        cell header
          text "1 mn"
        cell header
          text "1 hour"
        cell header
          text "1 day"
      var List:Str devices := disk_devices
      var Pointer:Str dev1 :> devices first
      while exists:dev1
        row
          cell
            text dev1
          for (var Int lap) 0 2
            cell
              if running_seconds>=(shunt lap=0 0 lap=1 3600\2 86400\2)
                disk_statistics dev1 (shunt lap=0 60 lap=1 3600 86400) (var Float read_bps) (var Float write_bps)
                text string:(cast read_bps/8/1024 Int)+" KB/s read + "+string:(cast write_bps/8/1024 Int)+" KB/s write"
        dev1 :> devices next dev1
    cat "file:/proc/mounts"
    var FileInfo root := file_query "file:/" extended
    (var Stream mnt) open "file:/proc/mounts" in+safe
    table
      row
        cell header
          text "Path"
        cell header
          text "Filesystem"
        cell header
          text "Label"
        cell header
          text "Load"
        cell header
          text "Free/Total"
      while not mnt:atend
        if (mnt:readline parse any:(var Str dev) _ any:(var Str path) _ any:(var Str fs) _ any:(var Str mode) _ any)
          if fs<>"rootfs" and fs<>"proc" and fs<>"sysfs" and fs<>"usbfs"
            var FileInfo pinfo := file_query "file:"+path extended
            var Str pre := "file:"
            if path<>"/" and (pinfo:options option "filesystem_device") and (pinfo:options option "filesystem_device" Int)=(root:options option "filesystem_device" Int)
              pre := "embedded:"
            var DiskInfo info := filesystem_query pre+path
            if info:size>=0
              row
                cell
                  fixed
                    text pre+path
                cell
                  text fs
                  if (","+mode+"," search ",rw," -1)=(-1)
                    style (text scale 8/72*25.4)
                      text " read only"
                cell
                  if (dev parse "/dev/" any)
                    text (filesystem_name "file:"+dev)
                cell
                  text string:(cast 100n*(info:size-info:available)\info:size Int)+" %"
                cell
                  text string:(cast info:available\2^20 Int)+" MB / "+string:(cast info:size\2^20 Int)+" MB"
    para
      ovar Str mdev := "device:/hda1"
      input "Device: " mdev
      ovar Str mpath := "file:/mnt/target/"
      input "path: " mpath
      input "options: " (ovar Str moptions)
      button "Mount"
        filesystem_mount mdev mpath moptions
        section_replay "main"
      eol
      input "Device or path: " (ovar Str dev_or_path)
      button "Dismount"
        filesystem_dismount dev_or_path
        section_replay "main"
    cat "file:/proc/mdstat"
    cat "file:/proc/scsi/scsi"
    header "IDE devices"
    for (var Int i) 0 7
      var Str device := "hd"+(character "a":number+i)
      (var Stream s) open "file:/proc/ide/"+device+"/model" in+safe
      var Str model := s readline
      (var Stream s) open "file:/proc/ide/"+device+"/media" in+safe
      var Str media := s readline
      if model<>""
        fixed
          text device+"  "+media+"  "+model+"[lf]"
    cat "file:/proc/partitions"

method context status_hardware
  arg_rw BrowserServerContext context
  implicit context
    title "Status - hardware"
    cat "file:/proc/cpuinfo"
    header "PCI devices"
    table
      row
        cell header
          text "c. ID"
        cell header
          text "constructor"
        cell header
          text "p. ID"
        cell header
          text "product"
        cell header
          text "rev"
        cell header
          text "driver"
        cell header
          text "product label"
      if (file_query "data:/pliant/fullpliant/pci_device_listing.txt" standard)=failure
        module "/pliant/protocol/http/client.pli"
        file_tree_create "data:/pliant/fullpliant/"
        file_copy "[dq]http://www.pcidatabase.com/reports.php[dq] option [dq]type=csv[dq]" "data:/pliant/fullpliant/pci_device_listing.txt" reduced
      (var Stream s) open "file:/proc/bus/pci/devices" in+safe
      while not s:atend
        var Str l := s readline
        var CBool matched := false
        matched := l parse any _ any:(var Str vendor_and_device) _ any:(var Str rev) _ any
        if matched
          if vendor_and_device<>""
            var Str vendor := vendor_and_device 0 4
            var Str device := vendor_and_device 4 4
          var Str vendor_name := "" ; var Str device_name := "" ; var Str device_label := ""
          (var Stream lst) open "data:/pliant/fullpliant/pci_device_listing.txt" in+safe
          while not lst:atend
            if (lst:readline parse (var Str vid) "," (var Str did) "," (var Str vn) "," (var Str dn) "," (var Str dl))
              if upper:vid=(upper "0x"+vendor)
                vendor_name := vn
                if upper:did=(upper "0x"+device)
                  device_name := dn
                  device_label := dl
          row
            cell
              text upper:vendor
            cell
              text vendor_name
            cell
              text upper:device
            cell
              text device_name
            cell
              text upper:rev
            cell
              void
            cell
              text device_label
    var Array:FileInfo bus := file_list "file:/proc/bus/" standard+directories
    for (var Int i) 0 bus:size-1
      cat bus:i:name+"devices"
    cat "file:/proc/ioports"
    cat "file:/proc/interrupts"
    cat "file:/proc/rtc"

method context status_kernel
  arg_rw BrowserServerContext context
  implicit context
    title "Status - kernel"
    var (Index Str Str) loaded_modules
    (var Stream s) open "file:/proc/modules" in+safe
    while not s:atend
      var Str l := s readline
      if not (l parse any:(var Str m) _ any)
        m := l
      m := replace m "-" "_"
      loaded_modules insert m m
    var (Index Str Str) extra_modules
    (var Stream s) open "file:/proc/sys/kernel/osrelease" in+safe
    var Str version := s readline
    (var Stream s) open "file:/lib/modules/"+version+"/modules.dep" in+safe
    while not s:atend
      var Str l := s readline
      while l<>"" and (l l:len-1 1)="/"
        l := (l 0 l:len-1)+s:readline
      if (l parse any:(var Str m) ":" any:(var Str d))
        m := m (m search_last "/" -1)+1 m:len
        m := m 0 (m search_last "." m:len)
        m := replace m "-" "_"
        if not exists:(loaded_modules first m)
          extra_modules insert m m
    title "Linux kernel informations"
    cat "file:/proc/sys/kernel/osrelease"
    cat "file:/proc/modules"
    para
      select "Module: " (ovar Str load_module)
        each cm extra_modules
          option cm cm
      button "load"
        kernel_load_module load_module
        section_replay "main"
      eol
      select "Module: " (ovar Str unload_module)
        each cm loaded_modules
          option cm cm
      button "unload"
        kernel_unload_module unload_module
        section_replay "main"
    cat "file:/proc/kmsg" 0.5

function shutdown timeout action
  arg Float timeout ; arg Str action
  thread
    sleep 2*timeout
    console "[lf]emergency "+action+"[lf]"
    if os_api="linux" and action="reboot"
      kernel_shutdown true
    eif os_api="linux" and action="poweroff"
      kernel_shutdown false
    process_exit 0
  console "(A"
  var DateTime start := datetime
  console "Shutdown:" eol
  tcp_servers_stop timeout
  console "B"
  process_shutdown
  console "C"
  var Int sec := cast datetime:seconds-start:seconds Int
  console "D)[lf]"
  if os_api="linux" and action="reboot"
    kernel_shutdown true
  eif os_api="linux" and action="poweroff"
    kernel_shutdown false
  if action<>""
    (var Stream s) open "file:/log/pliant.log" append+safe
    s writeline "restart "+string:datetime
    s close
    process_exit 0

method context status_shutdown
  arg_rw BrowserServerContext context
  implicit context
    title "Status - shutdown"
    ovar Float timeout := 120
    input "Shutdown maximal delay: " timeout
    style (text scale 8/72*25.4)
      text " (in seconds)"
    eol
    button "Fast restart"
      shutdown timeout "restart"
    if this_computer:env:"pliant":"system":"distribution"="fullpliant"
      button "Recompile and restart"
        var Array:FileInfo files := file_list "/binary/" standard
        for (var Int i) 0 files:size-1
          if files:i:extension=".dump"
            file_delete files:i:name
        shutdown timeout "restart"
    text" shutdown Pliant services, then stop or restart the services process." ; eol
    if this_computer:env:"pliant":"system":"distribution"="fullpliant"
      if os_api="linux"
        button "Reboot"
          shutdown timeout "reboot"
        text " "
        button "Reboot and check disks"
          (var Stream chk) open "file:/boot/checkdisk.flag" out+safe ; chk close
          shutdown timeout "reboot"
        text " shutdown Pliant services, then reboot the server." ; eol
        button "Power off"
          shutdown timeout "poweroff"
        text " shutdown Pliant services, then power off the server."

browser_page "/status"
  if subpath="/"
    ovar Str menu := ""
    window left
      section "menu" dynamic
        button "sumary" key "alt a" selected menu=""
          menu := ""
          section_replay "menu"
          section_replay "main"
        eol
        button "execution" key "alt c" selected menu="exec"
          menu := "exec"
          section_replay "menu"
          section_replay "main"
        eol
        button "memory" key "alt m" selected menu="memory"
          menu := "memory"
          section_replay "menu"
          section_replay "main"
        eol
        button "disk" key "alt d" selected menu="disk"
          menu := "disk"
          section_replay "menu"
          section_replay "main"
        eol
        button "network" key "alt n" selected menu="network"
          menu := "network"
          section_replay "menu"
          section_replay "main"
        eol
        button "hardware" key "alt h" selected menu="hardware"
          menu := "hardware"
          section_replay "menu"
          section_replay "main"
        eol
        button "kernel" key "alt k" selected menu="kernel"
          menu := "kernel"
          section_replay "menu"
          section_replay "main"
        eol
        button "shutdown" key "alt s" selected menu="shutdown"
          menu := "shutdown"
          section_replay "menu"
          section_replay "main"
        eol
        button "exit" key "alt x"
          url_return
    window main
      section "main" dynamic
        if menu=""
          status_sumary
        eif menu="disk"
          status_disk
        eif menu="hardware"
          status_hardware
        eif menu="kernel"
          status_kernel
        eif menu="shutdown"
          status_shutdown