my @internal_searchpaths;
+my $arglen = 200;
+
+sub get_command_and_cmdline($)
+{
+ my ($file, $args) = split /\s+/, $_[0], 2;
+
+ my $full = $file;
+ $full .= " $args" if defined $args;
+ $full =~ s/"/\\"/g;
+
+ if (length($full) > $arglen) {
+ print "$.: \"$full\" too long...\n";
+ exit 1;
+ }
+
+ ($file, $full);
+}
+
+sub error($)
+{
+ print STDERR shift;
+ exit(1);
+}
+
+sub handle_line($)
+{
+ my $r = shift;
+
+ if ($r =~ /^((perl|glob|shell):\s+)/)
+ {
+ substr $r, 0, length($1), "";
+
+ if ($2 eq 'perl')
+ {
+ my @m = eval $r;
+ die "perl: ".$@ if $@;
+ return @m;
+ }
+ elsif ($2 eq 'shell')
+ {
+ my @m = split /\n/, `$r`;
+ error "$mod_file:$.: Shell command failed\n" if $?;
+ return @m;
+ }
+ elsif ($2 eq 'glob')
+ {
+ return ( glob $r );
+ }
+ else
+ {
+ die "should not happen";
+ }
+ }
+
+ return ( $r );
+}
+
+sub handle_line_first($)
+{
+ return (handle_line(shift))[0];
+}
+
+sub readin_config($)
+{
+ my ($mod_file) = @_;
+
+ my @fs_fds;
+ my @fs_filenames;
+ my @mod_files_for_include;
+ my $fd;
+ my @contents;
+ my %file_to_id;
+ my %id_to_file;
+ my $file_id_cur = 0;
+
+ push @mod_files_for_include, $mod_file;
+
+ while (1)
+ {
+ if (@mod_files_for_include)
+ {
+ my $f = shift @mod_files_for_include;
+
+ if (grep { /^$f$/ } @fs_filenames)
+ {
+ print STDERR "$mod_file:$.: Warning: $f already included, skipping.\n";
+ next;
+ }
+
+ push @fs_filenames, $mod_file;
+ push @fs_fds, $fd;
+
+ undef $fd;
+ $mod_file = $f;
+ open($fd, $f) || error "Cannot open '$f': $!\n";
+
+ $id_to_file{$file_id_cur} = $f;
+ $file_to_id{$f} = $file_id_cur++;
+ }
+
+ while (<$fd>)
+ {
+ chomp;
+ s/#.*$//;
+ s/^\s*//;
+ next if /^$/;
+
+ my ($cmd, $remaining) = split /\s+/, $_, 2;
+ $cmd = lc($cmd);
+
+ if ($cmd eq 'include')
+ {
+ my @f = handle_line($remaining);
+ foreach my $f (@f)
+ {
+ my $abs;
+ if ($f =~ /^\//)
+ {
+ $abs = $f;
+ }
+ else
+ {
+ my @tmp = split /\/+/, $mod_file;
+ $tmp[@tmp - 1] = $f;
+ $abs = join('/', @tmp);
+ }
+ unshift @mod_files_for_include, glob $abs;
+ }
+
+ last;
+ }
+
+ push @contents, [ $file_to_id{$mod_file}, $., $_ ];
+ }
+
+ unless (defined $_)
+ {
+ close $fd;
+
+ $fd = pop @fs_fds;
+ $mod_file = pop @fs_filenames;
+
+ last unless defined $fd;
+ }
+ }
+
+
+ if (0)
+ {
+ print "$id_to_file{$$_[0]}($$_[0]):$$_[1]: $$_[2]\n" foreach (@contents);
+ }
+
+ return (
+ contents => [ @contents ],
+ file_to_id => { %file_to_id },
+ id_to_file => { %id_to_file },
+ );
+}
+
# extract an entry with modules from a modules.list file
sub get_module_entry($$)
{
my %groups;
if ($entry_to_pick eq 'auto-build-entry') {
- print "Automatic build entry is being built.\n";
- print "This image is useless but it always builds.\n";
+ # Automatic build entry is being built.
+ # This image is useless but it always builds.
$mods[0] = { command => 'Makefile', cmdline => 'Makefile', type => 'bin'};
$mods[1] = { command => 'Makefile', cmdline => 'Makefile', type => 'bin'};
$mods[2] = { command => 'Makefile', cmdline => 'Makefile', type => 'bin'};
return (
+ bootstrap => { command => 'bootstrap',
+ cmdline => 'bootstrap' },
mods => [ @mods ],
modaddr => 0x200000,
);
}
- open(M, $mod_file) || die "Cannot open $mod_file!: $!";
-
# preseed first 3 modules
$mods[0] = { command => 'fiasco', cmdline => 'fiasco', type => 'bin'};
$mods[1] = { command => 'sigma0', cmdline => 'sigma0', type => 'bin'};
$mods[2] = { command => 'roottask', cmdline => 'moe', type => 'bin'};
- my $arglen = 200;
- my $line = 0;
my $process_mode = undef;
my $found_entry = 0;
my $global = 1;
my $bootstrap_cmdline = "bootstrap";
my $linux_initrd;
my $is_mode_linux;
- while (<M>) {
- $line++;
- chomp;
- s/#.*$//;
- s/^\s*//;
- next if /^$/;
-
- if (/^modaddr\s+(\S+)/) {
- $modaddr_global = $1 if $global;
- $modaddr_title = $1 if !$global;
- next;
- }
- my ($type, $remaining) = split /\s+/, $_, 2;
- $type = lc($type);
+ my %mod_file_db = readin_config($mod_file);
+
+ foreach my $fileentry (@{$mod_file_db{contents}})
+ {
+ $_ = $$fileentry[2];
- $type = 'bin' if $type eq 'module';
+ chomp;
+ s/#.*$//;
+ s/^\s*//;
+ next if /^$/;
- if ($type =~ /^(entry|title)$/) {
- if (lc($entry_to_pick) eq lc($remaining)) {
- $process_mode = 'entry';
- $found_entry = 1;
- } else {
- $process_mode = undef;
+ if (/^modaddr\s+(\S+)/) {
+ $modaddr_global = $1 if $global;
+ $modaddr_title = $1 if !$global and $process_mode;
+ next;
}
- $global = 0;
- next;
- } elsif ($type eq 'searchpath') {
- push @internal_searchpaths, $remaining;
- next;
- } elsif ($type eq 'group') {
- $process_mode = 'group';
- $current_group_name = (split /\s+/, $remaining)[0];
- next;
- }
- next unless $process_mode;
+ my ($type, $remaining) = split /\s+/, $_, 2;
+ $type = lc($type);
- my @valid_types = ( 'bin', 'data', 'bin-nostrip', 'data-nostrip',
- 'bootstrap', 'roottask', 'kernel', 'sigma0',
- 'module-perl', 'module-shell', 'module-glob',
- 'module-group', 'initrd', 'set');
- die "$line: Invalid type \"$type\""
- unless grep(/^$type$/, @valid_types);
+ $type = 'bin' if $type eq 'module';
- @m = ( $remaining );
+ if ($type =~ /^(entry|title)$/) {
+ ($remaining) = handle_line($remaining);
+ if (lc($entry_to_pick) eq lc($remaining)) {
+ $process_mode = 'entry';
+ $found_entry = 1;
+ } else {
+ $process_mode = undef;
+ }
+ $global = 0;
+ next;
+ }
- if ($type eq 'set') {
- my ($varname, $value) = split /\s+/, $remaining, 2;
- $is_mode_linux = 1 if $varname eq 'mode' and lc($value) eq 'linux';
- }
+ if ($type eq 'searchpath') {
+ push @internal_searchpaths, handle_line($remaining);
+ next;
+ } elsif ($type eq 'group') {
+ $process_mode = 'group';
+ $current_group_name = (split /\s+/, handle_line_first($remaining))[0];
+ next;
+ } elsif ($type eq 'default-bootstrap') {
+ my ($file, $full) = get_command_and_cmdline(handle_line_first($remaining));
+ $bootstrap_command = $file;
+ $bootstrap_cmdline = $full;
+ next;
+ } elsif ($type eq 'default-kernel') {
+ my ($file, $full) = get_command_and_cmdline(handle_line_first($remaining));
+ $mods[0]{command} = $file;
+ $mods[0]{cmdline} = $full;
+ next;
+ } elsif ($type eq 'default-sigma0') {
+ my ($file, $full) = get_command_and_cmdline(handle_line_first($remaining));
+ $mods[1]{command} = $file;
+ $mods[1]{cmdline} = $full;
+ next;
+ } elsif ($type eq 'default-roottask') {
+ my ($file, $full) = get_command_and_cmdline(handle_line_first($remaining));
+ $mods[2]{command} = $file;
+ $mods[2]{cmdline} = $full;
+ next;
+ }
+
+ next unless $process_mode;
- if ($type eq 'module-perl') {
- @m = eval $remaining;
- die $@ if $@;
- $type = 'bin';
- } elsif ($type eq 'module-shell') {
- @m = split /\n/, `$remaining`;
- die "Shell command on line $line failed\n" if $?;
- $type = 'bin';
- } elsif ($type eq 'module-glob') {
- @m = glob $remaining;
- $type = 'bin';
- } elsif ($type eq 'module-group') {
- @m = ();
- foreach (split /\s+/, $remaining) {
- die "Unknown group '$_'" unless defined $groups{$_};
- push @m, @{$groups{$_}};
+ my @params = handle_line($remaining);
+
+ my @valid_types = ( 'bin', 'data', 'bin-nostrip', 'data-nostrip',
+ 'bootstrap', 'roottask', 'kernel', 'sigma0',
+ 'module-group', 'moe', 'initrd', 'set');
+ error "$mod_file_db{id_to_file}{$$fileentry[0]}:$$fileentry[1]: Invalid type \"$type\"\n"
+ unless grep(/^$type$/, @valid_types);
+
+
+ if ($type eq 'set') {
+ my ($varname, $value) = split /\s+/, $params[0], 2;
+ $is_mode_linux = 1 if $varname eq 'mode' and lc($value) eq 'linux';
}
- $type = 'bin';
- }
- if ($process_mode eq 'entry') {
- foreach my $m (@m) {
-
- my ($file, $args) = split /\s+/, $m, 2;
-
- my $full = $file;
- $full .= " $args" if defined $args;
- $full =~ s/"/\\"/g;
-
- if (length($full) > $arglen) {
- print "$line: \"$full\" too long...\n";
- exit 1;
- }
-
- # special cases
- if ($type eq 'bootstrap') {
- $bootstrap_command = $file;
- $bootstrap_cmdline = $full;
- } elsif ($type =~ /(rmgr|roottask)/i) {
- $mods[2]{command} = $file;
- $mods[2]{cmdline} = $full;
- } elsif ($type eq 'kernel') {
- $mods[0]{command} = $file;
- $mods[0]{cmdline} = $full;
- } elsif ($type eq 'sigma0') {
- $mods[1]{command} = $file;
- $mods[1]{cmdline} = $full;
- } elsif ($type eq 'initrd') {
- $linux_initrd = $file;
- $is_mode_linux = 1;
- } else {
- push @mods, {
- type => $type,
- command => $file,
- cmdline => $full,
- };
- }
+ if ($type eq 'module-group') {
+ my @m = ();
+ foreach (split /\s+/, join(' ', @params)) {
+ error "$mod_file_db{id_to_file}{$$fileentry[0]}:$$fileentry[1]: Unknown group '$_'\n" unless defined $groups{$_};
+ push @m, @{$groups{$_}};
+ }
+ @params = @m;
+ $type = 'bin';
+ } elsif ($type eq 'moe') {
+ $mods[2]{command} = 'moe';
+ $mods[2]{cmdline} = "moe rom/$params[0]";
+ $type = 'bin';
+ @m = ($params[0]);
+ }
+ next if not defined $params[0] or $params[0] eq '';
+
+ if ($process_mode eq 'entry') {
+ foreach my $m (@params) {
+
+ my ($file, $full) = get_command_and_cmdline($m);
+
+ # special cases
+ if ($type eq 'bootstrap') {
+ $bootstrap_command = $file;
+ $bootstrap_cmdline = $full;
+ } elsif ($type =~ /(rmgr|roottask)/i) {
+ $mods[2]{command} = $file;
+ $mods[2]{cmdline} = $full;
+ } elsif ($type eq 'kernel') {
+ $mods[0]{command} = $file;
+ $mods[0]{cmdline} = $full;
+ } elsif ($type eq 'sigma0') {
+ $mods[1]{command} = $file;
+ $mods[1]{cmdline} = $full;
+ } elsif ($type eq 'initrd') {
+ $linux_initrd = $file;
+ $is_mode_linux = 1;
+ } else {
+ push @mods, {
+ type => $type,
+ command => $file,
+ cmdline => $full,
+ };
+ }
+ }
+ } elsif ($process_mode eq 'group') {
+ push @{$groups{$current_group_name}}, @params;
+ } else {
+ error "$mod_file_db{id_to_file}{$$fileentry[0]}:$$fileentry[1]: Invalid mode '$process_mode'\n";
}
- } elsif ($process_mode eq 'group') {
- push @{$groups{$current_group_name}}, @m;
- } else {
- die "Invalid mode '$process_mode'";
}
- }
-
- close M;
- die "Unknown entry \"$entry_to_pick\"!" unless $found_entry;
- die "'modaddr' not set" unless $modaddr_title || $modaddr_global;
+ error "$mod_file: Unknown entry \"$entry_to_pick\"!\n" unless $found_entry;
+ error "$mod_file: 'modaddr' not set\n" unless $modaddr_title || $modaddr_global;
my $m = $modaddr_title || $modaddr_global;
if (defined $is_mode_linux)
{
- die "No Linux kernel image defined" unless defined $mods[0]{cmdline};
- print "Entry '$entry_to_pick' is a Linux type entry\n";
+ error "No Linux kernel image defined\n" unless defined $mods[0]{cmdline};
+ print STDERR "Entry '$entry_to_pick' is a Linux type entry\n";
my @files;
# @files is actually redundant but eases file selection for entry
# generators
$bootstrap_cmdline .= " -modaddr $m";
}
- my @filse; # again, this is redundant but helps generator functions
+ my @files; # again, this is redundant but helps generator functions
push @files, $bootstrap_command;
push @files, $_->{command} foreach @mods;
sub entry_is_mb(%)
{
my %e = @_;
- return defined $e{type} and $e{type} eq 'MB';
+ return defined $e{type} && $e{type} eq 'MB';
}
sub get_entries($)
my ($mod_file) = @_;
my @entry_list;
- open(M, $mod_file) || die "Cannot open $mod_file!: $!";
-
- while (<M>) {
- chomp;
- s/#.*$//;
- s/^\s*//;
- next if /^$/;
- push @entry_list, $2 if /^(entry|title)\s+(.+)/;
- }
+ my %mod_file_db = readin_config($mod_file);
- close M;
+ foreach my $fileentry (@{$mod_file_db{contents}})
+ {
+ push @entry_list, $2 if $$fileentry[2] =~ /^(entry|title)\s+(.+)/;
+ }
return @entry_list;
}
my $file = shift;
my $paths = shift;
my $f = search_file($file, $paths);
- die "Could not find '$file' with path '$paths'" unless defined $f;
+ error "Could not find '$file' with path '$paths'\n" unless defined $f;
$f;
}
-sub get_file_uncompressed_or_die($$$)
+sub get_or_copy_file_uncompressed_or_die($$$$)
{
- my $command = shift;
- my $paths = shift;
- my $tmpdir = shift;
+ my $command = shift;
+ my $paths = shift;
+ my $targetdir = shift;
+ my $copy = shift;
my $fp = L4::ModList::search_file_or_die($command, $paths);
- open F, $fp || die "connot open '$fp': $!";
+ open F, $fp || error "Cannot open '$fp': $!\n";
my $buf;
read F, $buf, 2;
close F;
- if (unpack("n", $buf) == 0x1f8b) {
- (my $tf = $fp) =~ s|.*/||;
- $tf = $tmpdir.'/'.$tf;
- print "'$fp' is a zipped file, uncompressing to '$tf'\n";
+ (my $tf = $fp) =~ s|.*/||;
+ $tf = $targetdir.'/'.$tf;
+
+ if (length($buf) >= 2 && unpack("n", $buf) == 0x1f8b) {
+ print STDERR "'$fp' is a zipped file, uncompressing to '$tf'\n";
system("zcat $fp >$tf");
$fp = $tf;
+ } elsif ($copy) {
+ print("cp $fp $tf\n");
+ system("cp $fp $tf");
+ $fp = $tf;
}
$fp;
}
+sub get_file_uncompressed_or_die($$$)
+{
+ return get_or_copy_file_uncompressed_or_die(shift, shift, shift, 0);
+}
+sub copy_file_uncompressed_or_die($$$)
+{
+ return get_or_copy_file_uncompressed_or_die(shift, shift, shift, 1);
+}
sub generate_grub1_entry($$%)
$s .= "}\n";
}
-
return 1;
projects / l4.git / blobdiff