/pliant/fullpliant/rules.pli
 
 1  abstract 
 2    [This module is applying the kind of macros that enable to specify a computer using a few items rather than the all set of individual settings.] 
 3   
 4  module "/pliant/language/stream.pli" 
 5  module "/pliant/language/context.pli" 
 6  module "/pliant/admin/md5.pli" 
 7  module "/pliant/protocol/http/server.pli" 
 8  module "/pliant/protocol/http/style/default.style" 
 9  module "debian.pli" 
 10  module "kernel.pli" 
 11  module "computer.pli" 
 12   
 13   
 14  method c study_hardware 
 15    arg_rw Data:Computer c 
 16    "hardware" "memory" "capacity" := string (cast memory_physical\2^20 Int) 
 17    var Int count := 0 
 18    (var Stream s) open "file:/proc/cpuinfo" in+safe 
 19    while not s:atend 
 20      var Str := readline 
 21      if (parse "processor" ":" any) 
 22        count += 1 
 23      if (parse "cpu" "family" ":" "6") 
 24        "hardware" "processor" "family" := "i386" 
 25      if (parse "cpu" "MHz" ":" (var Float mhz)) 
 26        "hardware" "processor" "speed" := string (cast mhz Int) 
 27      "hardware" "processor" "count" := string (max count 1) 
 28   
 29   
 30  method c apply_component component instance log 
 31    arg_rw Data:Computer c ; arg Str component ; arg Str instance ; arg_rw Stream log 
 32    var Data:ComputerComponent cc :> computer_database:data:component:component 
 33    each cc:include 
 34      apply_component instance log 
 35    each cc:variable 
 36      v:category (shunt v:instance<>"" v:instance instance) v:id := value 
 37      log writeline component+": "+v:category+" "+(shunt v:instance<>"" v:instance instance)+" "+v:id+" = "+v:value 
 38   
 39  method c apply_database_rules log 
 40    arg_rw Data:Computer c ; arg_rw Stream log 
 41    each cc c:content 
 42      apply_component cc:component cc:instance log 
 43   
 44   
 45  method c apply_extra_rules 
 46    arg_rw Data:Computer c 
 47    if (c:env:"hardware":"processor":"count" parse (var Int cpu)) and cpu>1 
 48      "kernel" "make" "CONFIG_SMP" := "y" 
 49      "package" "irqbalance" "version" := "" 
 50      "package" "irqbalance" "/usr/sbin/irqbalance" := "/bin/irqbalance" 
 51    if not (c:env:"hardware":"memory":"capacity" parse (var Int mb)) 
 52      mb := undefined 
 53    if true # 2.2 kernel 
 54      "kernel" "make" (shunt mb<=1024 "CONFIG_1GB" "CONFIG_2GB":= "y" 
 55    if true # 2.4 kernel 
 56      if mb<800 
 57        "kernel" "make" "CONFIG_NOHIGHMEM" := "y" 
 58      eif mb<=4096 
 59        "kernel" "make" "CONFIG_HIGHMEM" := "y" 
 60        "kernel" "make" "CONFIG_HIGHMEM4G" := "y" 
 61      else 
 62        "kernel" "make" "CONFIG_HIGHMEM" := "y" 
 63        "kernel" "make" "CONFIG_HIGHMEM64G" := "y" 
 64   
 65   
 66   
 67  method temp save_variables c component instance 
 68    arg_rw Data:Computer temp ; arg_rw Data:Computer c ; arg Str component instance 
 69    var Data:ComputerComponent cc :> computer_database:data:component:component 
 70    each cc:variable 
 71      if v:type<>"" 
 72        temp v:category (shunt v:instance<>"" v:instance instance) v:id := v:category (shunt v:instance<>"" v:instance instance) v:id 
 73    each cc:include 
 74      temp save_variables instance 
 75   
 76  method c compute reset logfile -> status 
 77    arg_rw Data:Computer c ; arg CBool reset ; arg Str logfile ; arg ExtendedStatus status 
 78    (var Stream log) open logfile out+safe 
 79    if not reset 
 80      var (Link Database:Computer) temp :> new Database:Computer 
 81      each cc c:content 
 82        temp:data save_variables cc:component cc:instance 
 83      each sw c:env:"software" 
 84        if (exists sw:"status"and sw:size<>1 
 85          temp:data "software" keyof:sw "status" := sw "status" 
 86    data_reset c:env 
 87    if (keyof:parse any:(var Str name) "." any:(var Str domain)) 
 88      "pliant" "identity" "name" := name 
 89      "pliant" "identity" "domain" := domain 
 90    else 
 91      "pliant" "identity" "name" := keyof c 
 92      "pliant" "identity" "domain" := "" 
 93    apply_database_rules log 
 94    if not reset 
 95      each category temp:data:env 
 96        each instance category 
 97          each id instance 
 98            keyof:category keyof:instance keyof:id := id 
 99            log writeline "restoring "+keyof:category+" "+keyof:instance+" "+keyof:id+" = "+id 
 100    if computer_fullname=keyof:c 
 101      study_hardware 
 102    apply_extra_rules 
 103    status := debian_select c 
 104    "kernel" "constant" "signature" := string_md5_hexa_signature (kernel_signature true) 
 105   
 106  export '. compute' 
 107   
 108   
 109 
 
 110   
 111   
 112  method page rec_display_variables c component instance stack 
 113    arg_rw HtmlPage page ; arg_rw Data:Computer c ; arg Str component instance stack 
 114    implicit page 
 115      if (stack search string:component+":"+string:instance -1)<>(-1) 
 116        highlight "circular reference to "+component+" "+instance ; eol 
 117        return   
 118      var Data:ComputerComponent cc :> computer_database:data:component:component 
 119      if cc:title<>"" 
 120        para 
 121          bold (text cc:title) 
 122      each cc:variable 
 123        if v:type<>"" 
 124          var Data:Str value :> v:category (shunt v:instance<>"" v:instance instance) v:id 
 125          if (v:type parse word:"option" any) 
 126            var Str options := type 
 127            select v:label+": " value 
 128              var Int indice := 0 
 129              while { var Int := options option_position "option" indice -1 ; p<>(-1) } 
 130                if ((options options:len) parse "option" (var Str labeli) (var Str valuei) any) 
 131                  option labeli valuei 
 132                indice += 1 
 133          eif v:length=defined 
 134            input v:label+": " value length v:length 
 135          else 
 136            input v:label+": " value 
 137      each cc:include 
 138        rec_display_variables instance stack+" "+string:component+":"+string:instance 
 139   
 140  method page display_variables c component instance 
 141    arg_rw HtmlPage page ; arg_rw Data:Computer c ; arg Str component instance 
 142    page rec_display_variables component instance "" 
 143   
 144  export '. display_variables' 
 145   
 146   
 147  method page display_kernel_settings c script 
 148    arg_rw HtmlPage page ; arg_rw Data:Computer c ; arg Str script 
 149    implicit page 
 150      var Str name := script 0 (script search_last "/" script:len) 
 151      part look_for_label 
 152        var Str label 
 153        for (var Int lap) 0 1 
 154          part scan_lap 
 155            (var Stream s) open "embedded:/usr/src/linux/"+script in+safe 
 156            while not s:atend 
 157              var Str := readline 
 158              if (parse word:"comment" "'" any:label "'" any) 
 159                leave look_for_label 
 160              if lap=and (parse "#" any:label) and label<>"" 
 161                leave look_for_label 
 162              if (parse word:"bool" "'" any "'" any) 
 163                leave scan_lap 
 164              eif (parse word:"tristate" "'" any "'" any) 
 165                leave scan_lap 
 166              eif (parse word:"dep_tristate" "'" any "'" any) 
 167                leave scan_lap 
 168        label := "" 
 169      if not (name parse any "/" any "/" any) 
 170        header (shunt label<>"" label name) 
 171      para 
 172        bold text:name ; fixed [  ] ; italic text:label 
 173      (var Stream s) open "embedded:/usr/src/linux/"+script in+safe 
 174      while not s:atend 
 175        var Str := readline 
 176        var Str option default 
 177        if (parse word:"bool" "'" any:(var Str label) "'" _ any:option _ any) or (parse word:"bool" "'" any "'" _ any:option) 
 178          default := "n" 
 179        eif (parse word:"tristate" "'" any:(var Str label) "'" _ any:option _ any) or (parse word:"tristate" "'" any "'" _ any:option) 
 180          default := "n" 
 181        eif (parse word:"dep_tristate" "'" any:(var Str label) "'" _ any:option _ any) or (parse word:"dep_tristate" "'" any "'" _ any:option) 
 182          default := "n" 
 183        eif (parse word:"int" "'" any:(var Str label) "'" _ any:option _ any:default) 
 184          void 
 185        eif (parse word:"string" "'" any:(var Str label) "'" _ any:option _ any:default) 
 186          void 
 187        else 
 188          option := "" 
 189        if option<>"" 
 190          var Str value := c:env:"kernel":"make":option 
 191          if value="y" 
 192            fixed text:(left option+" "+value 40 " ") 
 193          eif value="m" 
 194            font color (color hsl 240 100 50) 
 195              fixed text:(left option+" "+value 40 " ") 
 196          else 
 197            font color (color hsl 0 0 50) 
 198              fixed text:(left option+" "+value 40 " ") 
 199          fixed [  ] ; italic (small text:label) ; fixed [  ] 
 200          note "?" 
 201            title label 
 202            (var Stream help) open "embedded:/usr/src/linux/Documentation/Configure.help" in+safe 
 203            var CBool inside := false 
 204            while not help:atend 
 205              var Str := help readline 
 206              if (eparse "CONFIG_" any) and (parse any:(var Str tag)) 
 207                inside := tag=option 
 208              eif (0 2)="  " 
 209                if inside 
 210                  text (l:len) ; eol 
 211          eol 
 212      (var Stream s) open "embedded:/usr/src/linux/"+script in+safe 
 213      while not s:atend 
 214        var Str := readline 
 215        if (parse word:"source" any:(var Str sub)) 
 216          display_kernel_settings sub 
 217   
 218  method page display_kernel_settings c 
 219    arg_rw HtmlPage page ; arg_rw Data:Computer c 
 220    implicit page 
 221      title "Kernel settings for '"+keyof:c+"'" 
 222      display_kernel_settings "arch/i386/config.in" 
 223   
 224  export '. display_kernel_settings' 
 225