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