Patch title: Release 96 bulk changes
Abstract:
File: /pliant/graphic/ui/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/ui/server/context.pli"
module "/pliant/graphic/ui/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 UIServerContext context ; arg Str filename ; arg Float timeout
    implicit context
      (var Stream cf) open filename in+safe
      if cf=success
        header filename
        style set "standard/para/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 UIServerContext context ; arg Str filename
    context cat filename undefined

ui_function status_sumary
  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 set "standard/text/size" 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 set "standard/text/size" 8/72*25.4
                    text "RAID is ok"
                else
                  style set "standard/text/color" (color rgb 255 0 0) set "standard/text/bold" true set "standard/text/size" 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"

ui_function status_disk
  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 set "standard/text/size" 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"

ui_function status_hardware
  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"

ui_function status_kernel
  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

ui_function status_shutdown
  title "Status - shutdown"
  ovar Float timeout := 120
  input "Shutdown maximal delay: " timeout
  style set "standard/text/size" 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."

ui_path "/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