extract/codegen/kerneldb_to_parser.ml

   1 (* Memory info for virtual domains.
   2    (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   5    This program is free software; you can redistribute it and/or modify
   6    it under the terms of the GNU General Public License as published by
   7    the Free Software Foundation; either version 2 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18 *)
  19
  20 (* This program takes the kernel database (in kernels/ in toplevel
  21    directory) and generates parsing code for the various structures
  22    in the kernel that we are interested in.
  23
  24    The output programs -- *.ml, *.mli files of generated code -- go
  25    into lib/ at the toplevel, eg. lib/kernel_task_struct.ml
  26
  27    The stuff at the top of this file determine what structures
  28    and fields we try to parse.
  29 *)
  30
  31 let what = [
  32   "task_struct", (
  33     "struct task_struct {", "};", true,
  34     [ "state"; "prio"; "normal_prio"; "static_prio";
  35       "tasks.prev"; "tasks.next"; "comm"]
  36   );
  37   "mm_struct", (
  38     "struct mm_struct {", "};", true,
  39     [ ]
  40   );
  41   "net_device", (
  42     "struct net_device {", "};", true,
  43     [ "name"; "dev_addr" ]
  44   );
  45 ]
  46
  47 open ExtList
  48 open ExtString
  49 open Printf
  50
  51 let (//) = Filename.concat
  52
  53 let () =
  54   let args = Array.to_list Sys.argv in
  55
  56   let kernelsdir, outputdir =
  57     match args with
  58     | [_;kd;od] -> kd,od
  59     | _ ->
  60         let arg0 = Filename.basename Sys.executable_name in
  61         eprintf "%s - Turn kernels database into code modules.
  62
  63 Usage:
  64   %s <kernelsdir> <outputdir>
  65
  66 Example (from toplevel of virt-mem source tree):
  67   %s kernels/ lib/
  68 " arg0 arg0 arg0;
  69         exit 2 in
  70
  71   (* Get the *.info files from the kernels database. *)
  72   let infos = Sys.readdir kernelsdir in
  73   let infos = Array.to_list infos in
  74   let infos = List.filter (fun name -> String.ends_with name ".info") infos in
  75   let infos = List.map ((//) kernelsdir) infos in
  76
  77   (* Regular expressions.  We really really should use ocaml-mikmatch ... *)
  78   let re_oldformat = Pcre.regexp "^RPM: \\d+: \\(build \\d+\\) ([-\\w]+) ([\\w.]+) ([\\w.]+) \\(.*?\\) (\\w+)" in
  79   let re_keyvalue = Pcre.regexp "^(\\w+): (.*)" in
  80
  81   (* Parse in the *.info files.  These have historically had a few different
  82    * formats that we need to support.
  83    *)
  84   let infos = List.map (
  85     fun filename ->
  86       (* Get the basename (for getting the .data file later on). *)
  87       let basename = Filename.chop_suffix filename ".info" in
  88
  89       let chan = open_in filename in
  90       let line = input_line chan in
  91
  92       (* Kernel version string. *)
  93       let version =
  94         if Pcre.pmatch ~rex:re_oldformat line then (
  95           (* If the file starts with "RPM: \d+: ..." then it's the
  96            * original Fedora format.  Everything in one line.
  97            *)
  98           let subs = Pcre.exec ~rex:re_oldformat line in
  99           (* let name = Pcre.get_substring subs 1 in *)
 100           let version = Pcre.get_substring subs 2 in
 101           let release = Pcre.get_substring subs 3 in
 102           let arch = Pcre.get_substring subs 4 in
 103           close_in chan;
 104           (* XXX Map name -> PAE, hugemem etc. *)
 105           (* name, *) sprintf "%s-%s.%s" version release arch
 106         ) else (
 107           (* New-style "key: value" entries, up to end of file or the first
 108            * blank line.
 109            *)
 110           let (*name,*) version, release, arch =
 111             (*ref "",*) ref "", ref "", ref "" in
 112           let rec loop line =
 113             try
 114               let subs = Pcre.exec ~rex:re_keyvalue line in
 115               let key = Pcre.get_substring subs 1 in
 116               let value = Pcre.get_substring subs 2 in
 117               (*if key = "Name" then name := value
 118               else*) if key = "Version" then version := value
 119               else if key = "Release" then release := value
 120               else if key = "Architecture" then arch := value;
 121               let line = input_line chan in
 122               loop line
 123             with
 124               Not_found | End_of_file ->
 125                 close_in chan
 126           in
 127           loop line;
 128           let (*name,*) version, release, arch =
 129             (*!name,*) !version, !release, !arch in
 130           if (*name = "" ||*) version = "" || release = "" || arch = "" then
 131             failwith (sprintf "%s: missing Name, Version, Release or Architecture key" filename);
 132           (* XXX Map name -> PAE, hugemem etc. *)
 133           (* name, *) sprintf "%s-%s.%s" version release arch
 134         ) in
 135
 136       (*printf "%s -> %s\n%!" basename version;*)
 137
 138       (basename, version)
 139   ) infos in
 140
 141   (* For quick access to the opener strings, build a hash. *)
 142   let openers = Hashtbl.create 13 in
 143   List.iter (
 144     fun (name, (opener, closer, _, _)) ->
 145       Hashtbl.add openers opener (closer, name)
 146   ) what;
 147
 148   (* Now read the data files and parse out the structures of interest. *)
 149   let datas = List.map (
 150     fun (basename, version) ->
 151       let file_exists name =
 152         try Unix.access name [Unix.F_OK]; true
 153         with Unix.Unix_error _ -> false
 154       in
 155       let close_process_in cmd chan =
 156         match Unix.close_process_in chan with
 157         | Unix.WEXITED 0 -> ()
 158         | Unix.WEXITED i ->
 159             eprintf "%s: command exited with code %d\n" cmd i; exit i
 160         | Unix.WSIGNALED i ->
 161             eprintf "%s: command exited with signal %d\n" cmd i; exit 1
 162         | Unix.WSTOPPED i ->
 163             eprintf "%s: command stopped by signal %d\n" cmd i; exit 1
 164       in
 165
 166       (* Open the data file, uncompressing it on the fly if necessary. *)
 167       let chan, close =
 168         if file_exists (basename ^ ".data") then
 169           open_in (basename ^ ".data"), close_in
 170         else if file_exists (basename ^ ".data.gz") then (
 171           let cmd =
 172             sprintf "gzip -cd %s" (Filename.quote (basename ^ ".data.gz")) in
 173           Unix.open_process_in cmd, close_process_in cmd
 174         )
 175         else if file_exists (basename ^ ".data.bz2") then (
 176           let cmd =
 177             sprintf "bzip2 -cd %s" (Filename.quote (basename ^ ".data.bz2")) in
 178           Unix.open_process_in cmd, close_process_in cmd
 179         ) else
 180           failwith
 181             (sprintf "%s: cannot find corresponding data file" basename) in
 182
 183       (* Read the data file in, looking for structures of interest to us. *)
 184       let bodies = Hashtbl.create 13 in
 185       let rec loop () =
 186         let line = input_line chan in
 187
 188         (* If the line is an opener for one of the structures we
 189          * are looking for, then for now just save all the text until
 190          * we get to the closer line.
 191          *)
 192         (try
 193            let closer, name = Hashtbl.find openers line in
 194            let rec loop2 lines =
 195              let line = input_line chan in
 196              let lines = line :: lines in
 197              if String.starts_with line closer then List.rev lines
 198              else loop2 lines
 199            in
 200
 201            let body =
 202              try loop2 [line]
 203              with End_of_file ->
 204                failwith (sprintf "%s: %s: %S not matched by closing %S" basename name line closer) in
 205
 206            Hashtbl.replace bodies name body
 207          with Not_found -> ());
 208
 209         loop ()
 210       in
 211       (try loop () with End_of_file -> ());
 212
 213       close chan;
 214
 215       (* Make sure we got all the mandatory structures. *)
 216       List.iter (
 217          fun (name, (_, _, mandatory, _)) ->
 218            if mandatory && not (Hashtbl.mem bodies name) then
 219              failwith (sprintf "%s: structure %s not found in this kernel" basename name)
 220       ) what;
 221
 222       (basename, version, bodies)
 223   ) infos in
 224
 225   (* Now parse each structure body.
 226    * XXX This would be better as a proper lex/yacc parser.
 227    * XXX Even better would be to have a proper interface to libdwarves.
 228    *)
 229   let re_offsetsize = Pcre.regexp "/\\*\\s+(\\d+)\\s+(\\d+)\\s+\\*/" in
 230   let re_intfield = Pcre.regexp "int\\s+(\\w+);" in
 231   let re_ptrfield = Pcre.regexp "struct\\s+(\\w+)\\s*\\*\\s*(\\w+);" in
 232   let re_strfield = Pcre.regexp "char\\s+(\\w+)\\[(\\d+)\\];" in
 233   let re_structopener = Pcre.regexp "(struct|union)\\s+.*{$" in
 234   let re_structcloser = Pcre.regexp "}\\s*(\\w+)?(\\[\\d+\\])?;" in
 235
 236   (* 'basename' is the source file, and second parameter ('body') is
 237    * the list of text lines which covers this structure (minus the
 238    * opener line).  Result is the list of parsed fields from this
 239    * structure.
 240    *)
 241   let rec parse basename = function
 242     | [] -> assert false
 243     | [_] -> []                  (* Just the closer line, finished. *)
 244     | line :: lines when Pcre.pmatch ~rex:re_structopener line ->
 245       (* Recursively parse a sub-structure.  First search for the
 246        * corresponding closer line.
 247        *)
 248       let rec loop depth acc = function
 249         | [] ->
 250             eprintf "%s: %S has no matching close structure line\n%!"
 251               basename line;
 252             assert false
 253         | line :: lines when Pcre.pmatch ~rex:re_structopener line ->
 254           loop (depth+1) (line :: acc) lines
 255         | line :: lines
 256             when depth = 0 && Pcre.pmatch ~rex:re_structcloser line ->
 257           (line :: acc), lines
 258         | line :: lines
 259             when depth > 0 && Pcre.pmatch ~rex:re_structcloser line ->
 260           loop (depth-1) (line :: acc) lines
 261         | line :: lines -> loop depth (line :: acc) lines
 262       in
 263       let nested_body, rest = loop 0 [] lines in
 264
 265       (* Then parse the sub-structure. *)
 266       let struct_name, nested_body =
 267         match nested_body with
 268         | [] -> assert false
 269         | closer :: _ ->
 270             let subs = Pcre.exec ~rex:re_structcloser closer in
 271             let struct_name =
 272               try Some (Pcre.get_substring subs 1) with Not_found -> None in
 273             struct_name, List.rev nested_body in
 274       let nested_fields = parse basename nested_body in
 275
 276       (* Prefix the sub-fields with the name of the structure. *)
 277       let nested_fields =
 278         match struct_name with
 279         | None -> nested_fields
 280         | Some prefix ->
 281             List.map (
 282               fun (name, details) -> (prefix ^ "." ^ name, details)
 283             ) nested_fields in
 284
 285       (* Parse the rest. *)
 286       nested_fields @ parse basename rest
 287
 288     | line :: lines when Pcre.pmatch ~rex:re_intfield line ->
 289       (* An int field. *)
 290       let subs = Pcre.exec ~rex:re_intfield line in
 291       let name = Pcre.get_substring subs 1 in
 292       (try
 293          let subs = Pcre.exec ~rex:re_offsetsize line in
 294          let offset = int_of_string (Pcre.get_substring subs 1) in
 295          let size = int_of_string (Pcre.get_substring subs 2) in
 296          (name, (`Int, offset, size)) :: parse basename lines
 297        with
 298          Not_found -> parse basename lines
 299       );
 300
 301     | line :: lines when Pcre.pmatch ~rex:re_ptrfield line ->
 302       (* A pointer-to-struct field. *)
 303       let subs = Pcre.exec ~rex:re_ptrfield line in
 304       let struct_name = Pcre.get_substring subs 1 in
 305       let name = Pcre.get_substring subs 2 in
 306       (try
 307          let subs = Pcre.exec ~rex:re_offsetsize line in
 308          let offset = int_of_string (Pcre.get_substring subs 1) in
 309          let size = int_of_string (Pcre.get_substring subs 2) in
 310          (name, (`Ptr struct_name, offset, size)) :: parse basename lines
 311        with
 312          Not_found -> parse basename lines
 313       );
 314
 315     | line :: lines when Pcre.pmatch ~rex:re_strfield line ->
 316       (* A string (char array) field. *)
 317       let subs = Pcre.exec ~rex:re_strfield line in
 318       let name = Pcre.get_substring subs 1 in
 319       let width = int_of_string (Pcre.get_substring subs 2) in
 320       (try
 321          let subs = Pcre.exec ~rex:re_offsetsize line in
 322          let offset = int_of_string (Pcre.get_substring subs 1) in
 323          let size = int_of_string (Pcre.get_substring subs 2) in
 324          (name, (`Str width, offset, size)) :: parse basename lines
 325        with
 326          Not_found -> parse basename lines
 327       );
 328
 329     | _ :: lines ->
 330         (* Just ignore any other field we can't parse. *)
 331         parse basename lines
 332
 333   in
 334
 335   let datas = List.map (
 336     fun (basename, version, bodies) ->
 337       let structures = List.filter_map (
 338         fun (name, (_, _, _, wanted_fields)) ->
 339           let body =
 340             try Some (Hashtbl.find bodies name) with Not_found -> None in
 341           match body with
 342           | None -> None
 343           | Some body ->
 344               let body = List.tl body in (* Don't care about opener line. *)
 345               let fields = parse basename body in
 346
 347               (* That got us all the fields, but we only care about
 348                * the wanted_fields.
 349                *)
 350               let fields = List.filter (
 351                 fun (name, _) -> List.mem name wanted_fields
 352               ) fields in
 353
 354               (* Also check we have all the wanted fields. *)
 355               List.iter (
 356                 fun wanted_field ->
 357                   if not (List.mem_assoc wanted_field fields) then
 358                     failwith (sprintf "%s: structure %s is missing required field %s" basename name wanted_field)
 359               ) wanted_fields;
 360
 361               Some (name, fields)
 362       ) what in
 363
 364       (basename, version, structures)
 365   ) datas in
 366
 367   (* If you're debugging, uncomment this to print out the parsed
 368    * structures.
 369    *)
 370 (*
 371   List.iter (
 372     fun (basename, version, structures) ->
 373       printf "%s (version: %s):\n" basename version;
 374       List.iter (
 375         fun (struct_name, fields) ->
 376           printf "  struct %s {\n" struct_name;
 377           List.iter (
 378             fun (field_name, (typ, offset, size)) ->
 379               (match typ with
 380                | `Int -> printf "    int %s; " field_name
 381                | `Ptr struct_name ->
 382                    printf "    struct %s *%s; " struct_name field_name
 383                | `Str width ->
 384                    printf "    char %s[%d]; " field_name width
 385               );
 386               printf " /* offset = %d, size = %d */\n" offset size
 387           ) fields;
 388           printf "  }\n\n";
 389       ) structures;
 390   ) datas;
 391 *)
 392
 393   (* Let's generate some code! *)
 394
 395
 396
 397   ()