/pliant/linux/kernel/statistics.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  module "/pliant/language/context.pli" 
 3  module "/pliant/language/stream.pli" 
 4  module "/pliant/language/schedule/daemon.pli" 
 5  module "/pliant/fullpliant/this_computer.pli" 
 6   
 7  constant resolution 5 # in reconds 
 8  constant logical this_computer:env:"pliant":"system":"medium"="logical" 
 9   
 10  if not logical 
 11   
 12    type KernelStatRecord 
 13      field DateTime timestamp 
 14      field (Dictionary Str Intn) net_in net_out 
 15      field (Dictionary Str Intn) disk_read disk_write 
 16      field Intn interrupts 
 17      field Intn cpu 
 18     
 19     
 20    gvar Sem sem 
 21    gvar DateTime last_timestamp 
 22    gvar (Dictionary Str uInt) net_in_mark net_out_mark 
 23    gvar (Dictionary Str Intn) net_in_total net_out_total 
 24    gvar (Dictionary Str uInt) disk_read_mark disk_write_mark 
 25    gvar (Dictionary Str Intn) disk_read_total disk_write_total 
 26    gvar uInt interrupts_mark := 0 
 27    gvar Intn interrupts_total := 0 
 28    gvar Intn cpu_total := 0 
 29    gvar List:KernelStatRecord stat 
 30     
 31     
 32    function pick_net_marks in_mark out_mark 
 33      arg_w (Dictionary Str uInt) in_mark out_mark 
 34      in_mark := var (Dictionary Str uInt) empty_dictionary ; out_mark := var (Dictionary Str uInt) empty_dictionary 
 35      (var Stream proc) open "file:/proc/net/dev" in+safe 
 36      while not proc:atend 
 37        if (proc:readline parse any:(var Str device) ":" (var uInt r_bytes) (var uInt r_packets) (var uInt r_err) (var uInt r_drop) (var uInt r_fifo) (var uInt r_frame) (var uInt r_compressed) (var uInt r_multicast) (var uInt t_bytes) (var uInt t_packets) (var uInt t_err) (var uInt t_drop) (var uInt t_fifo) (var uInt t_colls) (var uInt t_carrier) (var uInt t_compressed)) 
 38          in_mark insert device r_bytes ; out_mark insert device t_bytes 
 39     
 40    function pick_disk_marks read_mark write_mark interrupts 
 41      arg_w (Dictionary Str uInt) read_mark write_mark ; arg_w uInt interrupts 
 42      read_mark := var (Dictionary Str uInt) empty_dictionary ; write_mark := var (Dictionary Str uInt) empty_dictionary 
 43      interrupts := 0 
 44      (var Stream proc) open "file:/proc/stat" in+safe 
 45      while not proc:atend 
 46        var Str l := proc readline 
 47        if (l parse word:"disk_io" ":" any:(var Str disks)) 
 48          while (disks parse "(" any:(var Str disk) ")" ":" "(" (var uInt nb_rw) "," (var uInt nb_read) "," (var uInt sec_read) "," (var uInt nb_write) "," (var uInt sec_write) ")" any:(var Str remain)) 
 49            read_mark insert disk sec_read ; write_mark insert disk sec_write 
 50            disks := remain 
 51        eif (l parse word:"intr" interrupts any) 
 52          void 
 53      (var Stream proc) open "file:/proc/diskstats" in+safe 
 54      while not proc:atend 
 55        var Str l := proc readline 
 56        if (l parse (var Int major) (var Int minor) _ any:(var Str disk) _ (var uInt nb_read) (var uInt sec_read) (var uInt nb_write)  (var uInt sec_write)) 
 57          read_mark insert disk sec_read ; write_mark insert disk sec_write 
 58     
 59    function pick_cpu_load load 
 60      arg_w Float load 
 61      (var Stream proc) open "file:/proc/loadavg" in+safe 
 62      if (proc:readline parse (var Float l1) (var Float l2) (var Float l3) any) 
 63        load := l1 
 64      else 
 65        load := 0 
 66     
 67    function add_stat_record 
 68      pick_net_marks (var (Dictionary Str uInt) net_in) (var (Dictionary Str uInt) net_out) 
 69      each m net_in 
 70        var Str d := net_in key m 
 71        net_in_total d 0 += m .-. (net_in_mark d 0) 
 72        net_in_mark d := m 
 73      each m net_out 
 74        var Str d := net_out key m 
 75        net_out_total d 0 += m .-. (net_out_mark d 0) 
 76        net_out_mark d := m 
 77      pick_disk_marks (var (Dictionary Str uInt) disk_read) (var (Dictionary Str uInt) disk_write) (var uInt interrupts) 
 78      each m disk_read 
 79        var Str d := disk_read key m 
 80        disk_read_total d 0 += m .-. (disk_read_mark d 0) 
 81        disk_read_mark d := m 
 82      each m disk_write 
 83        var Str d := disk_write key m 
 84        disk_write_total d 0 += m .-. (disk_write_mark d 0) 
 85        disk_write_mark d := m 
 86      interrupts_total += interrupts .-. interrupts_mark 
 87      interrupts_mark := interrupts 
 88      pick_cpu_load (var Float load) 
 89      var DateTime now := datetime 
 90      var Int sec := cast now:seconds-last_timestamp:seconds Int 
 91      cpu_total += cast sec*load*1000 Int 
 92      last_timestamp := now 
 93      var Link:KernelStatRecord r :> new KernelStatRecord 
 94      r timestamp := now 
 95      r net_in := net_in_total ; r net_out := net_out_total 
 96      r disk_read := disk_read_total ; r disk_write := disk_write_total 
 97      r interrupts := interrupts_total 
 98      r cpu := cpu_total 
 99      sem request 
 100      stat += r 
 101      sem release 
 102     
 103     
 104    function filter_stat_records 
 105      var DateTime now := datetime   
 106      sem request 
 107      var Float mini := resolution 
 108      var Pointer:KernelStatRecord r :> stat last 
 109      while { var Pointer:KernelStatRecord r2 :> stat previous r ; exists:r2 } 
 110        if now:seconds-r2:timestamp:seconds<mini 
 111          stat remove r 
 112        else 
 113          mini := 1.25*mini 
 114        r :> r2 
 115      sem release 
 116      
 117     
 118    function gather_statistics 
 119      daemon "gather Linux kernel statistics" 
 120        pick_net_marks net_in_mark net_out_mark 
 121        net_in_total := var (Dictionary Str Intn) empty_dict ; net_out_total := var (Dictionary Str Intn) empty_dict ; cpu_total := 0 
 122        last_timestamp := datetime 
 123        stat := var List:KernelStatRecord empty_list 
 124        add_stat_record 
 125        var Int lap := 0 
 126        while not daemon_emergency 
 127          daemon_sleep resolution 
 128          add_stat_record 
 129          lap += 1 
 130          if lap%6=0 
 131            filter_stat_records 
 132    gather_statistics 
 133   
 134  else 
 135   
 136    module "/pliant/util/encoding/http.pli" 
 137   
 138   
 139  function net_devices -> devices 
 140    arg List:Str devices 
 141    devices := var List:Str empty_list 
 142    if not logical 
 143      each c net_in_total 
 144        devices += net_in_total key c 
 145   
 146  function net_statistics device seconds in_bps out_bps 
 147    arg Str device ; arg Float seconds ; arg_w Float in_bps out_bps 
 148    if not logical 
 149      sem rd_request 
 150      var Pointer:KernelStatRecord last :> stat last 
 151      var Pointer:KernelStatRecord r :> last 
 152      while last:timestamp:seconds-r:timestamp:seconds<seconds and exists:(stat previous r) 
 153        r :> stat previous r 
 154      var Float sec := last:timestamp:seconds-r:timestamp:seconds 
 155      if sec<1 
 156        sec := 1 
 157      if device<>"" 
 158        in_bps := (cast (last:net_in first device 0)-(r:net_in first device 0) Float)*8/sec 
 159        out_bps := (cast (last:net_out first device 0)-(r:net_out first device 0) Float)*8/sec 
 160      else 
 161        in_bps := 0 
 162        each c last:net_in 
 163          var Str d := last:net_in key c 
 164          if d<>"lo" 
 165            in_bps += (cast (last:net_in first d 0)-(r:net_in first d 0) Float)*8/sec 
 166        out_bps := 0 
 167        each c last:net_out 
 168          var Str d := last:net_out key c 
 169          if d<>"lo" 
 170            out_bps += (cast (last:net_out first d 0)-(r:net_out first d 0) Float)*8/sec 
 171      sem rd_release 
 172    else 
 173      (var Stream s) open "tcp://127.0.0.1/client/80" in+out+safe 
 174      writeline "REPORT_LOAD_STATISTICS "+(http_encode "net "+string:device+" "+string:seconds)+" HTTP/1.1" 
 175      writeline "" 
 176      if not (s:readline parse any "net" (var Str adevice) (var Float aseconds) in_bps out_bps) 
 177        in_bps := undefined ; out_bps := undefined 
 178   
 179   
 180  function disk_devices -> devices 
 181    arg List:Str devices 
 182    devices := var List:Str empty_list 
 183    if not logical 
 184      each c disk_read_total 
 185        devices += disk_read_total key c 
 186   
 187  function disk_statistics device seconds read_bps write_bps 
 188    arg Str device ; arg Float seconds ; arg_w Float read_bps write_bps 
 189    if not logical 
 190      sem rd_request 
 191      var Pointer:KernelStatRecord last :> stat last 
 192      var Pointer:KernelStatRecord r :> last 
 193      while last:timestamp:seconds-r:timestamp:seconds<seconds and exists:(stat previous r) 
 194        r :> stat previous r 
 195      var Float sec := last:timestamp:seconds-r:timestamp:seconds 
 196      if sec<1 
 197        sec := 1 
 198      if device<>"" 
 199        read_bps := (cast (last:disk_read first device 0)-(r:disk_read first device 0) Float)*512*8/sec 
 200        write_bps := (cast (last:disk_write first device 0)-(r:disk_write first device 0) Float)*512*8/sec 
 201      else 
 202        read_bps := 0 
 203        each c last:disk_read 
 204          var Str d := last:disk_read key c 
 205          read_bps += (cast (last:disk_read first d 0)-(r:disk_read first d 0) Float)*512*8/sec 
 206        write_bps := 0 
 207        each c last:disk_write 
 208          var Str d := last:disk_write key c 
 209          write_bps += (cast (last:disk_write first d 0)-(r:disk_write first d 0) Float)*512*8/sec 
 210      sem rd_release 
 211    else 
 212      (var Stream s) open "tcp://127.0.0.1/client/80" in+out+safe 
 213      writeline "REPORT_LOAD_STATISTICS "+(http_encode "disk "+string:device+" "+string:seconds)+" HTTP/1.1" 
 214      writeline "" 
 215      if not (s:readline parse any "disk" (var Str adevice) (var Float aseconds) read_bps write_bps) 
 216        read_bps := undefined ; write_bps := undefined 
 217   
 218   
 219  function interrupts_statistics seconds -> ips 
 220    arg Float seconds ; arg Float ips 
 221    if not logical 
 222      sem rd_request 
 223      var Pointer:KernelStatRecord last :> stat last 
 224      var Pointer:KernelStatRecord r :> last 
 225      while last:timestamp:seconds-r:timestamp:seconds<seconds and exists:(stat previous r) 
 226        r :> stat previous r 
 227      var Float sec := last:timestamp:seconds-r:timestamp:seconds 
 228      if sec<1 
 229        sec := 1 
 230      ips := (cast last:interrupts-r:interrupts Float)/sec 
 231      sem rd_release 
 232    else 
 233      (var Stream s) open "tcp://127.0.0.1/client/80" in+out+safe 
 234      writeline "REPORT_LOAD_STATISTICS "+(http_encode "interrupts "+string:seconds)+" HTTP/1.1" 
 235      writeline "" 
 236      if not (s:readline parse any "interrupts" (var Float aseconds) ips) 
 237        ips := undefined 
 238   
 239   
 240  function cpu_statistics seconds -> load 
 241    arg Float seconds ; arg Float load 
 242    if not logical 
 243      sem rd_request 
 244      var Pointer:KernelStatRecord last :> stat last 
 245      var Pointer:KernelStatRecord r :> last 
 246      while last:timestamp:seconds-r:timestamp:seconds<seconds and exists:(stat previous r) 
 247        r :> stat previous r 
 248      var Float sec := last:timestamp:seconds-r:timestamp:seconds 
 249      if sec<1 
 250        sec := 1 
 251      load := (cast last:cpu-r:cpu Float)/1000/sec 
 252      sem rd_release 
 253    else 
 254      (var Stream s) open "tcp://127.0.0.1/client/80" in+out+safe 
 255      writeline "REPORT_LOAD_STATISTICS "+(http_encode "cpu "+string:seconds)+" HTTP/1.1" 
 256      writeline "" 
 257      if not (s:readline parse any "cpu" (var Float aseconds) load) 
 258        load := undefined 
 259   
 260   
 261  export net_devices net_statistics 
 262  export disk_devices disk_statistics 
 263  export interrupts_statistics cpu_statistics 
 264