l4/tool/lib/L4/ModList.pm

   1
   2 package L4::ModList;
   3 use Exporter;
   4 use vars qw(@ISA @EXPORT);
   5 @ISA    = qw(Exporter);
   6 @EXPORT = qw(get_module_entry search_file get_entries);
   7
   8 my @internal_searchpaths;
   9
  10 my $arglen = 200;
  11
  12 sub get_command_and_cmdline($)
  13 {
  14   my ($file, $args) = split /\s+/, $_[0], 2;
  15
  16   my $full = $file;
  17   $full .= " $args" if defined $args;
  18   $full =~ s/"/\\"/g;
  19
  20   if (length($full) > $arglen) {
  21     print "$line: \"$full\" too long...\n";
  22     exit 1;
  23   }
  24
  25   ($file, $full);
  26 }
  27
  28 # extract an entry with modules from a modules.list file
  29 sub get_module_entry($$)
  30 {
  31   my ($mod_file, $entry_to_pick) = @_;
  32   my @mods;
  33   my %groups;
  34
  35   if ($entry_to_pick eq 'auto-build-entry') {
  36     print "Automatic build entry is being built.\n";
  37     print "This image is useless but it always builds.\n";
  38
  39     $mods[0] = { command => 'Makefile', cmdline => 'Makefile', type => 'bin'};
  40     $mods[1] = { command => 'Makefile', cmdline => 'Makefile', type => 'bin'};
  41     $mods[2] = { command => 'Makefile', cmdline => 'Makefile', type => 'bin'};
  42
  43     return (
  44       mods    => [ @mods ],
  45       modaddr => 0x200000,
  46     );
  47   }
  48
  49   open(M, $mod_file) || die "Cannot open $mod_file!: $!";
  50
  51   # preseed first 3 modules
  52   $mods[0] = { command => 'fiasco',   cmdline => 'fiasco',   type => 'bin'};
  53   $mods[1] = { command => 'sigma0',   cmdline => 'sigma0',   type => 'bin'};
  54   $mods[2] = { command => 'roottask', cmdline => 'moe',      type => 'bin'};
  55
  56   my $line = 0;
  57   my $process_mode = undef;
  58   my $found_entry = 0;
  59   my $global = 1;
  60   my $modaddr_title;
  61   my $modaddr_global;
  62   my $bootstrap_command = "bootstrap";
  63   my $bootstrap_cmdline = "bootstrap";
  64   my $linux_initrd;
  65   my $is_mode_linux;
  66   while (<M>) {
  67     $line++;
  68     chomp;
  69     s/#.*$//;
  70     s/^\s*//;
  71     next if /^$/;
  72
  73     if (/^modaddr\s+(\S+)/) {
  74       $modaddr_global = $1 if  $global;
  75       $modaddr_title  = $1 if !$global;
  76       next;
  77     }
  78
  79     my ($type, $remaining) = split /\s+/, $_, 2;
  80     $type = lc($type);
  81
  82     $type = 'bin'   if $type eq 'module';
  83
  84     if ($type =~ /^(entry|title)$/) {
  85       if (lc($entry_to_pick) eq lc($remaining)) {
  86         $process_mode = 'entry';
  87         $found_entry = 1;
  88       } else {
  89         $process_mode = undef;
  90       }
  91       $global = 0;
  92       next;
  93     } elsif ($type eq 'searchpath') {
  94       push @internal_searchpaths, $remaining;
  95       next;
  96     } elsif ($type eq 'group') {
  97       $process_mode = 'group';
  98       $current_group_name = (split /\s+/, $remaining)[0];
  99       next;
 100     } elsif ($type eq 'default-bootstrap') {
 101       my ($file, $full) = get_command_and_cmdline($remaining);
 102       $bootstrap_command = $file;
 103       $bootstrap_cmdline = $full;
 104       next;
 105     } elsif ($type eq 'default-kernel') {
 106       my ($file, $full) = get_command_and_cmdline($remaining);
 107       $mods[0]{command}  = $file;
 108       $mods[0]{cmdline}  = $full;
 109       next;
 110     } elsif ($type eq 'default-sigma0') {
 111       my ($file, $full) = get_command_and_cmdline($remaining);
 112       $mods[1]{command}  = $file;
 113       $mods[1]{cmdline}  = $full;
 114       next;
 115     } elsif ($type eq 'default-roottask') {
 116       my ($file, $full) = get_command_and_cmdline($remaining);
 117       $mods[2]{command}  = $file;
 118       $mods[2]{cmdline}  = $full;
 119       next;
 120     }
 121
 122     next unless $process_mode;
 123
 124     my @valid_types = ( 'bin', 'data', 'bin-nostrip', 'data-nostrip',
 125                         'bootstrap', 'roottask', 'kernel', 'sigma0',
 126                         'module-perl', 'module-shell', 'module-glob',
 127                         'module-group', 'moe', 'initrd', 'set');
 128     die "$line: Invalid type \"$type\""
 129       unless grep(/^$type$/, @valid_types);
 130
 131     @m = ( $remaining );
 132
 133     if ($type eq 'set') {
 134       my ($varname, $value) = split /\s+/, $remaining, 2;
 135       $is_mode_linux = 1 if $varname eq 'mode' and lc($value) eq 'linux';
 136     }
 137
 138     if ($type eq 'module-perl') {
 139       @m = eval $remaining;
 140       die $@ if $@;
 141       $type = 'bin';
 142     } elsif ($type eq 'module-shell') {
 143       @m = split /\n/, `$remaining`;
 144       die "Shell command on line $line failed\n" if $?;
 145       $type = 'bin';
 146     } elsif ($type eq 'module-glob') {
 147       @m = glob $remaining;
 148       $type = 'bin';
 149     } elsif ($type eq 'module-group') {
 150       @m = ();
 151       foreach (split /\s+/, $remaining) {
 152         die "Unknown group '$_'" unless defined $groups{$_};
 153         push @m, @{$groups{$_}};
 154       }
 155       $type = 'bin';
 156     } elsif ($type eq 'moe') {
 157       $mods[2]{command}  = 'moe';
 158       $mods[2]{cmdline}  = "moe rom/$remaining";
 159       $type = 'bin';
 160       @m = ($remaining);
 161     }
 162
 163     if ($process_mode eq 'entry') {
 164       foreach my $m (@m) {
 165
 166         my ($file, $full) = get_command_and_cmdline($m);
 167
 168         # special cases
 169         if ($type eq 'bootstrap') {
 170           $bootstrap_command = $file;
 171           $bootstrap_cmdline = $full;
 172         } elsif ($type =~ /(rmgr|roottask)/i) {
 173           $mods[2]{command}  = $file;
 174           $mods[2]{cmdline}  = $full;
 175         } elsif ($type eq 'kernel') {
 176           $mods[0]{command}  = $file;
 177           $mods[0]{cmdline}  = $full;
 178         } elsif ($type eq 'sigma0') {
 179           $mods[1]{command}  = $file;
 180           $mods[1]{cmdline}  = $full;
 181         } elsif ($type eq 'initrd') {
 182           $linux_initrd      = $file;
 183           $is_mode_linux     = 1;
 184         } else {
 185           push @mods, {
 186                         type    => $type,
 187                         command => $file,
 188                         cmdline => $full,
 189                       };
 190         }
 191       }
 192     } elsif ($process_mode eq 'group') {
 193       push @{$groups{$current_group_name}}, @m;
 194     } else {
 195       die "Invalid mode '$process_mode'";
 196     }
 197   }
 198
 199   close M;
 200
 201   die "Unknown entry \"$entry_to_pick\"!" unless $found_entry;
 202   die "'modaddr' not set" unless $modaddr_title || $modaddr_global;
 203
 204   my $m = $modaddr_title || $modaddr_global;
 205   if (defined $is_mode_linux)
 206     {
 207       die "No Linux kernel image defined" unless defined $mods[0]{cmdline};
 208       print "Entry '$entry_to_pick' is a Linux type entry\n";
 209       my @files;
 210       # @files is actually redundant but eases file selection for entry
 211       # generators
 212       push @files, $mods[0]{command};
 213       push @files, $linux_initrd if defined $linux_initrd;
 214       my %r;
 215       %r = (
 216              # actually bootstrap is always the kernel in this
 217              # environment, for convenience we use $mods[0] because that
 218              # are the contents of 'kernel xxx' which sounds more
 219              # reasonable
 220              bootstrap => { command => $mods[0]{command},
 221                             cmdline => $mods[0]{cmdline}},
 222              type      => 'Linux',
 223              files     => [ @files ],
 224            );
 225       $r{initrd} = { cmdline => $linux_initrd } if defined $linux_initrd;
 226       return %r;
 227     }
 228
 229   # now some implicit stuff
 230   if ($bootstrap_cmdline =~ /-modaddr\s+/) {
 231     $bootstrap_cmdline =~ s/(-modaddr\s+)%modaddr%/$1$m/;
 232   } else {
 233     $bootstrap_cmdline .= " -modaddr $m";
 234   }
 235
 236   my @filse; # again, this is redundant but helps generator functions
 237   push @files, $bootstrap_command;
 238   push @files, $_->{command} foreach @mods;
 239
 240   return (
 241            bootstrap => { command => $bootstrap_command,
 242                           cmdline => $bootstrap_cmdline },
 243            mods    => [ @mods ],
 244            modaddr => $modaddr_title || $modaddr_global,
 245            type    => 'MB',
 246            files   => [ @files ],
 247          );
 248 }
 249
 250 sub entry_is_linux(%)
 251 {
 252   my %e = @_;
 253   return defined $e{type} && $e{type} eq 'Linux';
 254 }
 255
 256 sub entry_is_mb(%)
 257 {
 258   my %e = @_;
 259   return defined $e{type} and $e{type} eq 'MB';
 260 }
 261
 262 sub get_entries($)
 263 {
 264   my ($mod_file) = @_;
 265   my @entry_list;
 266
 267   open(M, $mod_file) || die "Cannot open $mod_file!: $!";
 268
 269   while (<M>) {
 270     chomp;
 271     s/#.*$//;
 272     s/^\s*//;
 273     next if /^$/;
 274     push @entry_list, $2 if /^(entry|title)\s+(.+)/;
 275   }
 276
 277   close M;
 278
 279   return @entry_list;
 280 }
 281
 282 # Search for a file by using a path list (single string, split with colons
 283 # or spaces, see the split)
 284 # return undef if it could not be found, the complete path otherwise
 285 sub search_file($$)
 286 {
 287   my $file = shift;
 288   my $paths = shift;
 289
 290   foreach my $p (split(/[:\s]+/, $paths), @internal_searchpaths) {
 291     return "$p/$file" if -e "$p/$file" and ! -d "$p/$file";
 292   }
 293
 294   return $file if $file =~ /^\// && -e $file;
 295
 296   undef;
 297 }
 298
 299 sub search_file_or_die($$)
 300 {
 301   my $file = shift;
 302   my $paths = shift;
 303   my $f = search_file($file, $paths);
 304   die "Could not find '$file' with path '$paths'" unless defined $f;
 305   $f;
 306 }
 307
 308 sub get_file_uncompressed_or_die($$$)
 309 {
 310   my $command = shift;
 311   my $paths   = shift;
 312   my $tmpdir  = shift;
 313
 314   my $fp = L4::ModList::search_file_or_die($command, $paths);
 315
 316   open F, $fp || die "connot open '$fp': $!";
 317   my $buf;
 318   read F, $buf, 2;
 319   close F;
 320
 321   if (length($buf) >= 2 && unpack("n", $buf) == 0x1f8b) {
 322     (my $tf = $fp) =~ s|.*/||;
 323     $tf = $tmpdir.'/'.$tf;
 324     print "'$fp' is a zipped file, uncompressing to '$tf'\n";
 325     system("zcat $fp >$tf");
 326     $fp = $tf;
 327   }
 328
 329   $fp;
 330 }
 331
 332
 333
 334
 335 sub generate_grub1_entry($$%)
 336 {
 337   my $entryname = shift;
 338   my $prefix = shift;
 339   $prefix = '' unless defined $prefix;
 340   $prefix = "/$prefix" if $prefix ne '' and $prefix !~ /^\//;
 341   my %entry = @_;
 342   my $s = "title $entryname\n";
 343   my $c = $entry{bootstrap}{cmdline};
 344   $c =~ s/^\S*\/([^\/]+\s*)/$1/;
 345   $s .= "kernel $prefix/$c\n";
 346
 347   if (entry_is_linux(%entry) and defined $entry{initrd})
 348     {
 349       $c = $entry{initrd}{cmdline};
 350       $c =~ s/^\S*\/([^\/]+\s*)/$1/;
 351       $s .= "initrd $prefix/$c\n";
 352       return $s;
 353     }
 354
 355   foreach my $m (@{$entry{mods}})
 356     {
 357       $c = $m->{cmdline};
 358       $c =~ s/^\S*\/([^\/]+\s*)/$1/;
 359       $s .= "module $prefix/$c\n";
 360     }
 361   $s;
 362 }
 363
 364 sub generate_grub2_entry($$%)
 365 {
 366   my $entryname = shift;
 367   my $prefix = shift;
 368   $prefix = '' unless defined $prefix;
 369   $prefix = "/$prefix" if $prefix ne '' and $prefix !~ /^\//;
 370   my %entry = @_;
 371   # basename of first path
 372   my ($c, $args) = split(/\s+/, $entry{bootstrap}{cmdline}, 2);
 373   my $bn = (reverse split(/\/+/, $c))[0];
 374   my $s = "menuentry \"$entryname\" {\n";
 375
 376   if (entry_is_linux(%entry))
 377     {
 378       $s .= "  echo Loading '$prefix/$bn $args'\n";
 379       $s .= "  linux $prefix/$bn $args\n";
 380       if (defined $entry{initrd})
 381         {
 382           $bn = (reverse split(/\/+/, $entry{initrd}{cmdline}))[0];
 383           my $c = $entry{initrd}{cmdline};
 384           $c =~ s/^\S*(\/[^\/]+\s*)/$1/;
 385           $s .= "  initrd $prefix$c\n";
 386         }
 387     }
 388   else
 389     {
 390       $s .= "  echo Loading '$prefix/$bn $prefix/$bn $args'\n";
 391       $s .= "  multiboot $prefix/$bn $prefix/$bn $args\n";
 392       foreach my $m (@{$entry{mods}})
 393         {
 394           # basename
 395           $bn = (reverse split(/\/+/, $m->{command}))[0];
 396           my $c = $m->{cmdline};
 397           $c =~ s/^\S*(\/[^\/]+\s*)/$1/;
 398           $s .= "  echo Loading '$prefix/$bn $c'\n";
 399           $s .= "  module $prefix/$bn $c\n";
 400         }
 401     }
 402   $s .= "  echo Done, booting...\n";
 403   $s .= "}\n";
 404 }
 405
 406
 407 return 1;