Patch title: Release 94 bulk changes
Abstract:
File: /pliant/fullpliant/status.page
Key:
    Removed line
    Added line
module "/pliant/language/context.pli"
module "/pliant/language/stream.pli"
module "/pliant/language/os.pli"
module "/pliant/language/schedule/threads_engine.pli"
module "/pliant/language/schedule/resourcesem.pli"
module "/pliant/language/data/cache.pli"
module "/pliant/admin/file.pli"
module "/pliant/fullpliant/this_computer.pli"
module "/pliant/fullpliant/user.pli"
module "/pliant/fullpliant/shutdown.pli"
module "/pliant/language/os/process.pli"
module "/pliant/protocol/http/site.pli"
module "/pliant/protocol/common/tcp_server.pli"
module "/pliant/language/os/socket.pli"
module "/pliant/util/network/ping.pli"
module "/pliant/util/network/bench.pli"
module "/pliant/appli/database.pli"
module "/pliant/storage/database.pli"
module "/pliant/language/debug/compile_log.pli"
if os_api="linux"
  module "/pliant/linux/storage/filesystem.pli"
  module "/pliant/linux/kernel/statistics.pli"
  module "/pliant/protocol/time/client.pli"
  module "/pliant/linux/schedule/rtc.pli"
  module "/pliant/linux/storage/filesystem.pli"
  module "/pliant/linux/network/boot.pli"
  module "/pliant/linux/kernel/module.pli"

requires "browse_status"

if allowed:"administrator"
  memory_checkup

title "'"+computer_fullname+"' status"

function hexa_value s -> h
  arg Str s ; arg uInt h
  h := 0
  for (var Int i) 0 s:len-1
    var Char c := s i ; var Int d
    if c>="0" and c<="9"
      d := c:number-"0":number
    eif c>="A" and c<="F"
      d := 10+c:number-"A":number
    eif c>="a" and c<="f"
      d := 10+c:number-"a":number
    h := h*16+d

function hexa_ip s -> ip
  arg Str s ; arg Str ip
  var uInt h := hexa_value s ; ip := ""
  for (var Int i) 0 3
    ip += "."+string:(h .and. 0FFh)
    h \= 100h
  ip := ip 1 ip:len

section "connection"
header "Your connection"

  para
    [Your browser is identifying itself as: ] ; bold (text http_request:browser) ; eol
    if http_request:browser_model<>""
      [Pliant interpreted it as ] ; bold (text http_request:browser_model) ; [ release ] ; ; bold text:(string http_request:browser_release) ; eol
    else
      [Pliant could not determine the extact browser model.] ; eol
    if os_api<>"win32"
      if http_request:answer_encoding<>""
        text "Pliant will send it "+http_request:answer_encoding+" compressed HTML pages."
      else
        [Pliant will send it uncompressed HTML pages.]
  para
    if user_name<>""
      [You are currently identifyed as user: ] ; bold text:user_name ; eol
    else
      [You are currently not logged in.] ; eol
  para
    note "more details"
      title "Details about this HTTP connection"
      para
        [Your IP address is ] ; fixed text:(http_request:stream safe_query "remote_ip_address")
      para
        [Here is what your browser said:] ; eol
        fixed
          var Pointer:Arrow c :> http_request:query_log first
          while c<>null
            text "  "+(c map Str) ; eol
            c :> http_request:query_log next c
      para
        [Here are informations about the Pliant web site your are currently connected to:] ; eol
        [Site name is: ] ; fixed (text http_request:site_name) ; eol
        var Str skey := (site http_request:site_name) public_key
        if skey<>""
          html (replace "Site public key is:" " " "&nbsp;") ; fixed [  ] ; small (fixed text:skey) ; eol
        [Area path is: ] ; fixed (text http_request:area_path) ; eol
        [Area root is: ] ; fixed (text http_request:area_root) ; eol
        [Style is: ] ; fixed (text http_request:style_name) ; eol
        [Style options are: ] ; fixed (text http_request:style_options) ; eol
      para
        if user_name<>""
          [You are currently identifyed as user: ] ; bold text:user_name
        else
          [You are currently not logged in.]
        eol
        var Str ukey := user:user_name public_key
        if ukey<>""
          html (replace "Your public key is:" " " "&nbsp;") ; fixed [  ] ; small (fixed text:ukey) ; eol

section "statistics"
header "HTTP server statistics"

  var Pointer:HttpServer server :> http_request server
  var DateTime now := datetime
  var Float running_seconds := now:seconds-server:since:seconds
  para
    text "Current time is "+string:now
    if this_computer:env:"pliant":"system":"distribution"="fullpliant"
      text " GMT"
    if os_api="linux" and allowed:"administrator"
      fixed [  ]
      note " adjust time"
        title "Adjust hardware time"
        var DateTime official := nist_datetime
        var DateTime hardware := rtc_get_datetime
        var DateTime system := datetime
        table columns 3
          cell void ; cell header [Time] ; cell header [delta]
          cell header [Official]
          cell
            fixed (text string:official)
          cell void
          cell header [Hardware clock]
          cell
            fixed (text string:hardware)
          cell
            if (abs hardware:seconds-official:seconds)<3
              text string:(cast (hardware:seconds-official:seconds)*1000 Int)+" ms"
            else
              text string:(cast hardware:seconds-official:seconds Int)+" s"
          cell header [System]
          cell
            fixed (text string:system)
          cell
            if (abs system:seconds-official:seconds)<3
              text string:(cast (system:seconds-official:seconds)*1000 Int)+" ms"
            else
              text string:(cast system:seconds-official:seconds Int)+" s"
        para
          button "Automatically ajust everything"
            part adjust "slowly adjusting time"
              nist_adjust 20
            reload_page
          [May take a long time if the time is far from correct.]
        para
          button "Automatically set" noeol
            var DateTime auto := nist_datetime
            if auto=defined
              rtc_set_datetime nist_datetime
            reload_page
          [ hardware clock according to official time.] ; eol
          [This is the recommended action if the clock is completely false, then rebooting will be required to adjust system time.]
        para
          var DateTime dt := hardware
          button "Manually set" noeol
            if dt=defined
              rtc_set_datetime dt
            reload_page
          input " hardware clock to the specifyed time: " dt
          [The system time will get synchronized with hardware time only when rebooting.]
        [Official time is provided by some NIST servers on the Internet.] ; eol

  para
    text "HTTP server was started on "+(string server:since)+" (that's "
    bold
      text (string now:date:days-server:since:date:days)
    text " days ago)" ; eol
  para
    server:hits_sem rd_request
    text "Total number of hits: "+(string server:hits_count) ; eol
    text "Total number of bytes: "+(string server:bytes_count)+" bytes ("+(string server:bytes_count\2^20)+" MB)" ; eol
    server:hits_sem rd_release
    text "Number of clients currently connected: "+(string server:clients_count) ; eol


section "load"
header "Server load report"

  para
    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 server was booted on "+string:boot+" (that's "
        text (string now:date:days-boot:date:days)
        text " days ago)" ; eol
    if allowed:"administrator"
      note "display compiler log"
        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

  if os_api="linux"
    method page cat filename
      arg_rw HtmlPage page ; arg Str filename
    method page cat filename timeout
      arg_rw HtmlPage page ; arg Str filename ; arg Float timeout
      (var Stream cf) open filename in+safe
      if cf=success
        header filename
        fixed
          while (os_socket_wait cf:stream_handle 1 0.5)=success and not cf:atend
          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 page cat filename
      arg_rw HtmlPage page ; arg Str filename
      page cat filename undefined
  table columns 5
    cell void
    cell header [1 mn]
    cell header [1 hour]
    cell header [1 day]
    cell void
    cell header [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)
              small
                text " ("+(string l1*100)+"%)"
        eif lap=0
          text "Not available under "+os_kernel
    cell
      if allowed:"administrator"
        note "details"
          memory_checkup
          title "CPU load report"
          header "Documentation"
            [In the status page, the number between brackets was the number provided by Linux kernel in /proc/loadavg, whereas other numbers are the result of consolidating this number over time.] ; eol
            [See ] ; link "statistics.pli" "/pliant/linux/kernel/statistics.pli" ; [ for extra details on how consolidating is implemented.]
          header "List of the running threads in this process"
            para
              text "Number of threads currently running in this process: "+string:current_running_threads ; eol
              text "Maximum number of running threads was: "+string:maximum_running_threads ; eol
              if os_api="linux"
                text "Number of allocated stacks: "+string:thread_stacks_count ; eol
            table columns 3
              cell header [Thread action stack]
              cell header [PID]
              cell header [Status]
              thread_list_sem request
              var Pointer:ThreadHeader h :> thread_list_pivot:list_next
              while addressof:h<>addressof:thread_list_pivot
                var Str state := ""
                if os_api="linux"
                  (var Stream status) open "file:/proc/"+(string h:pid)+"/status" in+safe
                  while not status:atend
                    status:readline parse "State" ":" any "(" any:state ")"
                if state="running"
                  cell color (color hsl 60 50 75)
                    h:action_sem request
                    var Pointer:ActionRecord a :> h top_action
                    while exists:a
                      text a:action ; eol
                      a :> a next
                    h:action_sem release
                eif state<>"sleeping"
                  cell color (color hsl 30 50 75)
                    h:action_sem request
                    var Pointer:ActionRecord a :> h top_action
                    while exists:a
                      text a:action ; eol
                      a :> a next
                    h:action_sem release
                else
                  cell
                    h:action_sem request
                    var Pointer:ActionRecord a :> h top_action
                    while exists:a
                      text a:action ; eol
                      a :> a next
                    h:action_sem release
                cell
                  if os_api="linux"
                    if false
                      var Int pid := h pid
                      note string:pid
                        button "Kill this thread"
                          thread
                            sleep 5
                            process_exit 1
                          os_kill pid os_SIGTERM       
                        [Be carrefull: if you press this button, it will kill Pliant process.]
                    else
                      text (string h:pid)
                cell
                  text state
                h :> h list_next
              thread_list_sem release
          if os_api="linux"
            header "List of all operating system threads"
              var Array:FileInfo files := file_list "file:/proc/" standard+directories+relative
              para
                var Int count := 0
                for (var Int i) 0 files:size-1
                  if (files:i:name parse (var Int drop) "/")
                    count += 1
                text "Total number of threads running in the server: "+string:count ; eol
              table columns 4
                cell header [Command]
                cell header [PID]
                cell header [UID GID]
                cell header [Status]
                for (var Int i) 0 files:size-1
                  if (files:i:name parse (var Int pid) "/")
                    var Str name := "" ; var Int uid := undefined ; var Int gid := undefined ; var Str state := ""
                    (var Stream status) open "file:/proc/"+string:pid+"/status" in+safe
                    while not status:atend
                      var Str l := status readline
                      l parse "Name" ":" any:name
                      l parse "Uid" ":" uid any
                      l parse "Gid" ":" gid any
                      l parse "State" ":" any "(" any:state ")"
                    if state="running"
                      cell color (color hsl 60 20 75)
                        text name
                    eif state<>"sleeping"
                      cell color (color hsl 30 20 75)
                        text name
                    else
                      cell
                        text name
                    cell
                      text string:pid
                    cell
                      text string:uid+" "+string:gid
                    cell
                      text state
 
    cell header [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
    cell
      if allowed:"administrator"
        note "details"
          memory_checkup
          title "Memory load report"
          header "This Pliant process"
            text "Memory currently used: "+(string memory_current_used\2^20)+" MB"
            fixed [ ] ; small (text "("+string:memory_current_used+" bytes)") ; eol
            [Memory currently consumed: ] ; bold text:(string memory_current_consumed\2^20) ; text " MB"
            fixed [ ] ; small (text "("+string:memory_current_consumed+" bytes)") ; eol
            text "Maximum consumed memory has been: "+(string memory_maximum_consumed\2^20)+" MB"
            fixed [ ] ; small (text "("+string:memory_maximum_consumed+" bytes)") ; eol
            text "Pliant has been configured to try to keep used memory under: "+(string memory_assigned\2^20)+" MB"
            fixed [ ] ; small (text "("+string:memory_assigned+" bytes)") ; eol
          header "Server global memory"
            if os_api="linux"
              (var Stream proc2) 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 proc2:atend
                var Str l := proc2 readline
                l parse "MemTotal" ":" total any
                l parse "MemFree" ":" free any
                l parse "Buffers" ":" buffers any
                l parse "Cached" ":" cached any
                l parse "SwapTotal" ":" swap_total any
                l parse "SwapFree" ":" swap_free any
              if total<>0 and free<>0
                var Int extra := max buffers+cached-16*2^10 0
                var Intn memory_total := total*2n^10
                var Intn memory_free := (free+extra)*2n^10
                var Intn memory_swap_total := swap_total*2n^10
                var Intn memory_swap_free := swap_free*2n^10
                text "Total memory on this system: "+(string memory_total\2^20)+" MB"
                if memory_swap_total<>0
                  text " + "+(string memory_swap_total\2^20)+" MB of swap"
                eol
                text "Memory consumed by this Pliant process: "+(string memory_current_consumed\2^20)+" MB" ; eol
                text "Memory consumed by other processes and kernel: "+(string (memory_total-memory_current_consumed-memory_free+memory_swap_total-memory_swap_free)\2^20)+" MB" ; eol
                if memory_swap_free<>0
                  text "Memory still available: "+(string memory_free\2^20)+" MB"
                  text " + "+(string memory_swap_free\2^20)+" MB of swap"
                  [ = ] ; bold text:(string (memory_free+memory_swap_free)\2^20) ; [ MB]
                else
                  [Memory still available: ] ; bold text:(string memory_free\2^20) ; [ MB]
                eol
              else
                [Not available with this Linux kernel]
            eif os_api="win32"
              os_GlobalMemoryStatus (var os_MEMORYSTATUS ms2)
              text "Total memory on this system: "+(string ms2:dwTotalPhys\2^20)+" MB"
              if ms2:dwTotalPageFile<>0
                text " + "+(string ms2:dwTotalPageFile\2^20)+" MB of swap"
              eol
              text "Memory consumed by this Pliant process: "+(string memory_current_consumed\2^20)+" MB" ; eol
              if ms2:dwAvailPageFile<>0
                text "Memory still available: "+(string ms2:dwAvailPhys\2^20)+" MB"
                text " + "+(string ms2:dwAvailPageFile\2^20)+" MB of swap"
                [ = ] ; bold text:(string (ms2:dwAvailPhys+ms2:dwAvailPageFile)\2^20) ; [ MB]
              else
                [Memory still available: ] ; bold text:(string ms2:dwAvailPhys\2^20) ; [ MB]
            else
              text "Not available under "+os_kernel
          if os_api="linux" and allowed:"administrator"
            header "Linux kernel memory informations"
              cat "file:/proc/meminfo"
              cat "file:/proc/swaps"
    cell header [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 [  ]
              if ok
                small [RAID is ok]
              else
                highlight "RAID alarm"
            fixed [   ]
          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
    cell
      if os_api="linux" and allowed:"administrator"
        note "details"
          title "Linux kernel storage informations"
          header "Disk IO statistics"
            table columns 4
              cell header [Device]
              cell header [1 mn]
              cell header [1 hour]
              cell header [1 day]
              var List:Str devices := disk_devices
              var Pointer:Str dev1 :> devices first
              while exists:dev1
                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"
          para
            var FileInfo root := file_query "file:/" extended
            (var Stream mnt) open "file:/proc/mounts" in+safe
            table columns 3
              cell header [Path]
              cell header [Load]
              cell header [Free/Total]
              while not mnt:atend
                if (mnt:readline parse any _ any:(var Str path) _ any) and path<>"/proc" and path<>file_os_name:"embedded:/proc"
                if (mnt:readline parse any _ any:(var Str path) _ any) and path<>"/proc" and path<>file_os_name:"embedded:/proc" and path<>"/sys" and path<>file_os_name:"embedded:/sys" and path<>"/proc/bus/usb" and path<>file_os_name:"embedded:/proc/bus/usb"
                  var FileInfo pinfo := file_query "file:"+path extended
                  var Str pre := "file:"
                  if path<>"/" and (pinfo:options option "device") and (pinfo:options option "device" Int)=(root:options option "device" Int)
                  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
                    cell
                      fixed (text pre+path)
                    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
            var Str dev := "device:/hda1"
            input "Device: " dev length 12 noeol
            var Str path := "file:/mnt/target/"
            input "path: " path noeol
            input "options: " (var Str options) length 10 noeol
            button "Mount"
              filesystem_mount dev path options
              reload_page
            input "Device or path: " (var Str dev_or_path) noeol
            button "Dismount"
              filesystem_dismount dev_or_path
              reload_page
          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"
    cell header [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
    cell
      if os_api="linux" and allowed:"administrator"
        note "details"
          title "Linux kernel network informations"
          header "Bandwidth usage"
            table columns 4
              cell header [Device]
              cell header [1 mn]
              cell header [1 hour]
              cell header [1 day]
              var List:Str devices := net_devices
              var Pointer:Str dev :> devices first
              while exists:dev
                cell
                  text dev
                for (var Int lap) 0 2
                  cell
                    if running_seconds>=(shunt lap=0 0 lap=1 3600\2 86400\2)
                      net_statistics dev (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"
                dev :> devices next dev
          cat "file:/proc/net/dev"
          cat "file:/proc/net/route"
          cat "file:/dev/isdninfo"
          header "TCP connections"
            table columns 6
              cell header [Local IP]
              cell header [Local[lf]port]
              cell header [Remote IP]
              cell header [Remote[lf]port]
              cell header [Status]
              cell header [Timeout]
              for (var Int lap) 0 1
                (var Stream tcp) open "file:/proc/net/tcp" in+safe
                while not tcp:atend
                  if (tcp:readline parse (var Int num) ":" any:(var Str lip) ":" any:(var Str lport) _ any:(var Str rip) ":" any:(var Str rport) _ any:(var Str st) _ any _ any _ any _ any:(var Str uid) _ any:(var Str to) _ any)
                    if (shunt lap=0 st<>"06" st="06")
                      cell
                        text hexa_ip:lip
                      cell
                        text (string hexa_value:lport)
                      cell
                        text hexa_ip:rip
                      cell
                        text (string hexa_value:rport)
                      cell
                        text (shunt st="01" "established" st="02" "sent" st="03" "recv" st="04" "fin wait1" st="05" "fin wait2" st="06" "time wait" st="07" "close" st="08" "close wait" st="09" "last ack" st="0A" "listing" st="0B" "closing" st)
                      cell
                        text to
          header "Check connection"
            button "Test TCP ports"
              title "TCP ports used"
              table columns 2
                cell header [TCP Port]
                cell header [Service]
                for (var Int i) 1 65535
                  (var Stream s) open "tcp://localhost/client/"+string:i in+out+safe
                  if s=success
                    cell (text string:i)
                    cell
                      text (shunt i=21 "FTP" i=25 "SMTP" i=53 "DNS" i=80 "HTTP" i=110 "POP3" i=111 "NFS" i=139 "Samba" i=515 "LPD" i=548 "Netatalk" i=580 "secured HTTP" i=611 "remote" i=6000 "X11" "")
            input "Remote computer: " (var Str host) noeol
            var Int bench_seconds := 180
            input "Bench time in seconds: " bench_seconds length 4
            button "Can we access it ?" noeol
              if (dns_query_prototype host dns_query_function)=""
                table columns 1 border 0
                  cell color (color hsl 0 20 75)
                    text "Cannot find IP address of "+host
              eif net_ping:host=success
                table columns 1 border 0
                  cell color (color hsl 120 20 75)
                    text host+" can be accessed."
              else
                table columns 1 border 0
                  cell color (color hsl 0 20 75)
                    text host+" cannot be accessed."
            button "Test connection speed and reliability"
              net_bench host "seconds "+string:bench_seconds (var Float upload_kbps) (var Float download_kbps) (var Float reliability)
              title "Network connection to "+host
              table columns 2
                cell [Upload speed]
                cell
                  if upload_kbps=undefined
                    [Could not connect to remote benchmark service]
                  eif upload_kbps<10000
                    text string:(cast upload_kbps Int)+" Kbps"
                  else
                    text string:(cast upload_kbps/1024 Int)+" Mbps"
                cell [Download speed]
                cell
                  if download_kbps=undefined
                    [Could not connect to remote benchmark service]
                  eif download_kbps<10000
                    text string:(cast download_kbps Int)+" Kbps"
                  else
                    text string:(cast download_kbps/1024 Int)+" Mbps"
                cell [Reliability]
                cell
                  text string:(cast reliability*100 Int)+"%"
          header "Reconfigure"
            button "Reboot network layer"
              net_boot
              reload_page
    if os_api="linux" and allowed:"administrator"
      cell header [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"
      cell
        page note "details"
          title "Linux kernel hardware informations"
          cat "file:/proc/cpuinfo"
          header "PCI devices"
            table columns 7
              cell header [c. ID]
              cell header [constructor]
              cell header [p. ID]
              cell header [product]
              cell header [rev]
              cell header [driver]
              cell header [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
                  cell
                    text upper:vendor
                  cell
                    text vendor_name
                  cell
                    text upper:device
                  cell
                    text device_name
                  cell
                    text upper:rev
                  cell
                    if lap=1
                      text (l (l search_last "[tab]" l:len)+1 l:len)
                  cell
                    text device_label
          cat "file:/proc/pci"
          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"
      cell header [OS kernel] ; cell void ; cell void ; cell void
      cell
        page note "details"
          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: " (var Str load_module) noeol
              each cm extra_modules
                option cm cm
            button "load"
              kernel_load_module load_module
              reload_page
            select "Module: " (var Str unload_module) noeol
              each cm loaded_modules
                option cm cm
            button "unload" noeol
              kernel_unload_module unload_module
              reload_page
          cat "file:/proc/kmsg"
          cat "file:/proc/kmsg" 0.5

  table columns 3
    cell header [Service]
    cell header [TCP ports count]
    cell header [Clients currently connected]
    tcp_servers_sem rd_request
    var Pointer:Arrow c :> tcp_servers_list first
    while c<>null
      var Link:TcpServer s :> c map TcpServer
      cell (text s:name)
      cell text:(string s:ports_count)
      cell text:(string s:clients_count)
      c :> tcp_servers_list next c
    tcp_servers_sem rd_release
  para
    tcp_resource query (var Int consumed) (var Int total)
    small
      text "TCP connections used: "+string:consumed+"/"+string:total

if allowed:"administrator"

  section "actions"
  header "Actions"

    var Bool recompile := server dynamic_auto_recompile
    select "Auto detect and recompile modifyed dynamic pages: " recompile noeol
      option "yes" "true"
      option "no" "false"
    button "Apply change"
      http_request:server dynamic_auto_recompile := recompile
      reload_page

    button "Store databases" noeol
      data_store true
      reload_page
    button "Shrink ressources" noeol
      threads_shrink
      cache_shrink 0 cache_class_costy
      reload_page

    button "Shutdown"
      title "Shutdown Pliant server"
      var Float timeout := 120
      input "Shutdown maximal delay: " timeout length 4 noeol ; small [ (in seconds)] ; eol
      button "Fast restart" noeol
        shutdown timeout "restart"
      if this_computer:env:"pliant":"system":"distribution"="fullpliant"
        button "Recompile and restart" noeol
          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"
      [ 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" noeol
            shutdown timeout "reboot"
          [ ]
          button "Reboot and check disks" noeol
            (var Stream chk) open "file:/boot/checkdisk.flag" out+safe ; chk close
            shutdown timeout "reboot"
          [ shutdown Pliant services, then reboot the server.] ; eol
          button "Power off" noeol
            shutdown timeout "poweroff"
          [ shutdown Pliant services, then power off the server.] ; eol