basis/unix/linux/proc/proc.factor

   1 ! Copyright (C) 2013 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays combinators combinators.smart
   4 io.encodings.utf8 io.files kernel math math.order math.parser
   5 memoize sequences sorting.slots splitting splitting.monotonic
   6 strings io.pathnames calendar words ;
   7 IN: unix.linux.proc
   8
   9 ! /proc/*
  10
  11 ! /proc/buddyinfo
  12 ! /proc/cgroups
  13
  14 TUPLE: proc-cmdline string ;
  15 C: <proc-cmdline> proc-cmdline
  16 : parse-proc-cmdline ( -- obj )
  17     "/proc/cmdline" utf8 file-lines first <proc-cmdline> ;
  18
  19
  20 TUPLE: processor-info
  21     { processor integer }
  22     { vendor-id string }
  23     { cpu-family integer }
  24     { model integer }
  25     { model-name string }
  26     { stepping integer }
  27     { microcode integer }
  28     { cpu-mhz number }
  29     { cache-size integer }
  30     { fdiv-bug? boolean }
  31     { hlt-bug? boolean }
  32     { f00f-bug? boolean }
  33     { coma-bug? boolean }
  34     { physical-id integer }
  35     { siblings integer }
  36     { core-id integer }
  37     { cpu-cores integer }
  38     { apicid integer }
  39     { initial-apicid integer }
  40     { fpu? boolean }
  41     { fpu-exception? boolean }
  42     { cpuid-level integer }
  43     { wp? boolean }
  44     { flags array }
  45     { bogomips number }
  46     { clflush-size integer }
  47     { cache-alignment integer }
  48     { address-sizes array }
  49     { power-management string }
  50     { tlb-size string }
  51     { bugs string }
  52     { vmx-flags string } ;
  53
  54
  55 ERROR: unknown-cpuinfo-line string ;
  56
  57 : line>processor-info ( processor-info string -- processor-info )
  58     ":" split first2 swap
  59     [ CHAR: \t = ] trim-tail [ [ CHAR: \s = ] trim ] bi@
  60     {
  61         { "address sizes" [
  62             "," split [ [ CHAR: \s = ] trim " " split first string>number ] map
  63             >>address-sizes
  64         ] }
  65         { "apicid" [ string>number >>apicid ] }
  66         { "bogomips" [ string>number >>bogomips ] }
  67         { "cache size" [
  68             " " split first [ CHAR: \s = ] trim
  69             string>number 1024 * >>cache-size
  70         ] }
  71         { "cache_alignment" [ string>number >>cache-alignment ] }
  72         { "clflush size" [ string>number >>clflush-size ] }
  73         { "coma_bug" [ "yes" = >>coma-bug? ] }
  74         { "core id" [ string>number >>core-id ] }
  75         { "cpu MHz" [ string>number >>cpu-mhz ] }
  76         { "cpu cores" [ string>number >>cpu-cores ] }
  77         { "cpu family" [ string>number >>cpu-family ] }
  78         { "cpuid level" [ string>number >>cpuid-level ] }
  79         { "f00f_bug" [ "yes" = >>f00f-bug? ] }
  80         { "fdiv_bug" [ "yes" = >>fdiv-bug? ] }
  81         { "flags" [ " " split harvest >>flags ] }
  82         { "fpu" [ "yes" = >>fpu? ] }
  83         { "fpu_exception" [ "yes" = >>fpu-exception? ] }
  84         { "hlt_bug" [ "yes" = >>hlt-bug? ] }
  85         { "initial apicid" [ string>number >>initial-apicid ] }
  86         { "microcode" [ string>number >>microcode ] }
  87         { "model" [ string>number >>model ] }
  88         { "model name" [ >>model-name ] }
  89         { "physical id" [ string>number >>physical-id ] }
  90         { "power management" [ >>power-management ] }
  91         { "processor" [ string>number >>processor ] }
  92         { "siblings" [ string>number >>siblings ] }
  93         { "stepping" [ string>number >>stepping ] }
  94         { "vendor_id" [ >>vendor-id ] }
  95         { "wp" [ "yes" = >>wp? ] }
  96         { "TLB size" [ >>tlb-size ] }
  97         { "bugs" [ >>bugs ] }
  98         { "vmx flags" [ >>vmx-flags ] }
  99         [ unknown-cpuinfo-line ]
 100     } case ;
 101
 102
 103 ! Linux 2.6 has fewer values than new kernels
 104 : lines>processor-info ( strings -- processor-info )
 105     [ processor-info new ] dip
 106     [ line>processor-info ] each ;
 107
 108 : parse-proc-cpuinfo ( -- seq )
 109     "/proc/cpuinfo" utf8 file-lines
 110     { "" } split harvest [ lines>processor-info ] map ;
 111
 112 : sort-cpus ( seq -- seq )
 113     { { physical-id>> <=> } { core-id>> <=> } } sort-by
 114     [ [ physical-id>> ] bi@ = ] monotonic-split
 115     [ [ [ core-id>> ] bi@ = ] monotonic-split ] map ;
 116
 117 : cpu-counts ( seq -- #cpus #cores #hyperthread )
 118     [ length ]
 119     [ [ length ] map-sum ]
 120     [ [ [ length ] map-sum ] map-sum ] tri ;
 121
 122
 123 TUPLE: proc-loadavg
 124     load-average-1
 125     load-average-5
 126     load-average-15
 127     #processes-executing
 128     #processes-total
 129     last-pid ;
 130
 131 : parse-proc-loadavg ( -- obj )
 132     "/proc/loadavg" utf8 file-lines first
 133     " " split [
 134         {
 135             [ string>number ]
 136             [ string>number ]
 137             [ string>number ]
 138             [ "/" split1 [ string>number ] bi@ ]
 139             [ string>number ]
 140         } spread
 141     ] input<sequence proc-loadavg boa ;
 142
 143
 144 ! In the file as kb, convert to bytes
 145 TUPLE: proc-meminfo
 146     mem-total
 147     mem-free
 148     buffers
 149     cached
 150     swap-cached
 151     active
 152     inactive
 153     active-anon
 154     inactive-anon
 155     active-file
 156     inactive-file
 157     unevictable
 158     mlocked
 159     swap-total
 160     swap-free
 161     dirty
 162     writeback
 163     anon-pages
 164     mapped
 165     shmem
 166     slab
 167     s-reclaimable
 168     s-unreclaimable
 169     kernel-stack
 170     page-tables
 171     nfs-unstable
 172     bounce
 173     writeback-tmp
 174     commit-limit
 175     committed-as
 176     vmalloc-total
 177     vmalloc-used
 178     vmalloc-chunk
 179     hardware-corrupted
 180     anon-huge-pages
 181     huge-pages-total
 182     huge-pages-free
 183     huge-pages-rsvd
 184     huge-pages-surp
 185     huge-page-size
 186     direct-map-4k
 187     direct-map-2m ;
 188
 189 ! Different kernels have fewer fields. Make sure we have enough.
 190 : parse-proc-meminfo ( -- meminfo )
 191     "/proc/meminfo" utf8 file-lines
 192     [ " " split harvest second string>number 1024 * ] map
 193     proc-meminfo "slots" word-prop length f pad-tail
 194     [ proc-meminfo boa ] input<sequence ;
 195
 196 ! All cpu-stat fields are measured in jiffies.
 197 TUPLE: proc-stat
 198     cpu
 199     cpus
 200     intr
 201     ctxt
 202     btime
 203     processes
 204     procs-running
 205     procs-blocked
 206     softirq ;
 207
 208 TUPLE: proc-cpu-stat name user nice system idle iowait irq softirq steal guest guest-nice ;
 209
 210 : line>cpu ( string -- cpu )
 211     " " split
 212     unclip-slice
 213     [ [ [ CHAR: \s = ] trim string>number ] map ] dip prefix
 214     [ proc-cpu-stat boa ] input<sequence ;
 215
 216 : parse-proc-stat ( -- obj )
 217     "/proc/stat" utf8 file-lines
 218     [ first ] [ 7 head* rest ] [ 7 tail* ] tri 3array {
 219         [ first line>cpu ]
 220         [ second [ line>cpu ] map ]
 221         [
 222             third
 223             [ " " split1 nip " " split [ string>number ] map ] map
 224             [
 225                 {
 226                     [ ]
 227                     [ first ]
 228                     [ first ]
 229                     [ first ]
 230                     [ first ]
 231                     [ first ]
 232                     [ ]
 233                 } spread
 234             ] input<sequence
 235         ]
 236     } cleave proc-stat boa ;
 237
 238 : active-cpus ( -- n )
 239     parse-proc-stat procs-running>> ;
 240
 241 TUPLE: proc-partition major minor #blocks name ;
 242
 243 : parse-proc-partitions ( -- partitions )
 244     "/proc/partitions" utf8 file-lines 2 tail
 245     [
 246         " \t" split harvest
 247         [
 248             {
 249                 [ string>number ]
 250                 [ string>number ]
 251                 [ string>number ]
 252                 [ ]
 253             } spread
 254         ] input<sequence proc-partition boa
 255     ] map ;
 256
 257 TUPLE: proc-swap filename type size used priority ;
 258
 259 : parse-proc-swaps ( -- sequence )
 260     "/proc/swaps" utf8 file-lines rest
 261     [
 262         " \t" split harvest
 263         [
 264             {
 265                 [ ]
 266                 [ ]
 267                 [ string>number ]
 268                 [ string>number ]
 269                 [ string>number ]
 270             } spread
 271         ] input<sequence proc-swap boa
 272     ] map ;
 273
 274 TUPLE: proc-uptime up idle ;
 275
 276 : parse-proc-uptime ( -- uptime )
 277     "/proc/uptime" utf8 file-lines first
 278     " " split first2 [ string>number seconds ] bi@
 279     proc-uptime boa ;
 280
 281 ! /proc/pid/*
 282
 283 GENERIC#: proc-pid-path 1 ( object string -- path )
 284
 285 M: integer proc-pid-path ( pid string -- path )
 286     [ "/proc/" ] 2dip
 287     [ number>string "/" append ] dip
 288     3append ;
 289
 290 M: string proc-pid-path ( pid-string string -- path )
 291     [ "/proc/" ] 2dip [ append-path ] dip append-path ;
 292
 293 : proc-file-lines ( path -- strings ) utf8 file-lines ;
 294 : proc-first-line ( path -- string/f ) proc-file-lines ?first ;
 295
 296 : proc-pid-first-line ( pid string -- string )
 297     proc-pid-path proc-first-line ;
 298
 299 : parse-proc-pid-cmdline ( pid -- string/f )
 300     "cmdline" proc-pid-path proc-first-line ;
 301
 302 TUPLE: pid-stat pid filename state parent-pid group-id session-id terminal#
 303     terminal-group-id task-flags
 304     #minor-page-faults #minor-page-faults-child
 305     #major-page-faults #major-page-faults-child
 306     cpu-user cpu-kernel
 307     cpu-user-children cpu-kernel-children
 308     priority
 309     niceness
 310     #threads
 311     zero0
 312     nanos-since-boot
 313     virtual-memory
 314     resident-set-size resident-set-limit
 315     start-address end-address stack-start-address
 316     current-stack-pointer current-instruction-pointer
 317     pending-signals blocked-signals ignored-signals
 318     handled-signals
 319     wait-address
 320     zero1
 321     zero2
 322     exit-signal
 323     task-cpu
 324     realtime-policy
 325     policy
 326     blkio-ticks
 327     guest-time children-guest-time
 328     start-data end-data
 329     start-brk
 330     arg-start arg-end
 331     env-start env-end
 332     exit-code ;
 333
 334 : parse-proc-pid-stat ( pid -- stat )
 335     "stat" proc-pid-path
 336     proc-first-line
 337     " " split harvest
 338     pid-stat "slots" word-prop length "0" pad-tail
 339     [ dup string>number [ nip ] when* ] map
 340     [ pid-stat boa ] input<sequence ;