1#!/usr/bin/perl
2=head1 NAME
3
4Linux::Bootloader - Base class interacting with Linux bootloaders
5
6=head1 SYNOPSIS
7
8
9	my $bootloader = new Linux::Bootloader();
10        my $config_file='/boot/grub/menu.lst';
11
12	$bootloader->read($config_file);
13	$bootloader->print_info('all');
14	$bootloader->add(%hash);
15	$bootloader->update(%hash);
16	$bootloader->remove(2);
17	$bootloader->get_default();
18	$bootloader->set_default(2);
19	%hash = $bootloader->read_entry(0);
20	$bootloader->write($config_file);
21
22
23=head1 DESCRIPTION
24
25This module provides base functions for working with bootloader configuration files.
26
27=head1 FUNCTIONS
28
29=head2 new()
30
31	Creates a new Linux::Bootloader object.
32
33=head2 read()
34
35	Reads configuration file into an array.
36	Takes: string.
37	Returns: undef on error.
38
39=head2 write()
40
41	Writes configuration file.
42	Takes: string.
43	Returns: undef on error.
44
45=head2 print_info()
46
47	Prints information from config.
48	Takes: string.
49	Returns: undef on error.
50
51=head2 _info()
52
53	Parse config into array of hashes.
54	Takes: nothing.
55	Returns: array of hashes.
56
57=head2 get_default()
58
59	Determine current default kernel.
60	Takes: nothing.
61	Returns: integer, undef on error.
62
63=head2 set_default()
64
65	Set new default kernel.
66	Takes: integer.
67	Returns: undef on error.
68
69=head2 add()
70
71	Add new kernel to config.
72	Takes: hash.
73	Returns: undef on error.
74
75=head2 update()
76
77	Update args of an existing kernel entry.
78	Takes: hash.
79	Returns: undef on error.
80
81=head2 remove()
82
83	Remove kernel from config.
84	Takes: string.
85	Returns: undef on error.
86
87=head2 read_entry()
88
89        Read an existing entry into a hash suitable to add or update from.
90	Takes: integer or title
91	Returns: undef or hash
92
93=head2 debug($level)
94
95        Sets or gets the current debug level, 0-5.
96        Returns:  Debug level
97
98=head2 _check_config()
99
100        Conducts a basic check for kernel validity
101        Returns:  true if checks out okay,
102                  false if not okay,
103                  undef on error
104
105=head2 _lookup()
106
107        Converts title into position.
108	Takes: string.
109        Returns:  integer,
110                  undef on error
111
112=cut
113
114
115package Linux::Bootloader;
116
117use strict;
118use warnings;
119
120use vars qw( $VERSION );
121
122
123sub new {
124    my $this = shift;
125    my $class = ref($this) || $this;
126    if ( defined $class and $class  eq 'Linux::Bootloader' ){
127        my $detected_bootloader = Linux::Bootloader::Detect::detect_bootloader();
128        unless (defined $detected_bootloader) { return undef; }
129        $class = "Linux::Bootloader::" . "\u$detected_bootloader";
130        eval" require $class; ";
131    }
132    my $self = bless ({}, $class);
133    $self->{config_file} = shift;
134    unless (defined $self->{'config_file'}){
135        $self->_set_config_file();
136    }
137
138    $self->{config}	= [];
139    $self->{debug}	= 0;
140    $self->{'entry'}    = {};
141
142    return $self;
143}
144
145
146### Generic Functions ###
147
148# Read config file into array
149
150sub read {
151  my $self=shift;
152  my $config_file=shift || $self->{config_file};
153  print ("Reading $config_file.\n") if $self->debug()>1;
154
155  open(CONFIG, "$config_file")
156    || warn ("ERROR:  Can't open $config_file.\n") && return undef;
157  @{$self->{config}}=<CONFIG>;
158  close(CONFIG);
159
160  print ("Current config:\n @{$self->{config}}") if $self->debug()>4;
161  print ("Closed $config_file.\n") if $self->debug()>2;
162  return 1;
163}
164
165
166# Write new config
167
168sub write {
169  my $self=shift;
170  my $config_file=shift || $self->{config_file};
171  my @config=@{$self->{config}};
172
173  return undef unless $self->_check_config();
174
175  print ("Writing $config_file.\n") if $self->debug()>1;
176  print join("",@config) if $self->debug() > 4;
177
178  if (-w $config_file) {
179    system("cp","$config_file","$config_file.bak.boottool");
180    if ($? != 0) {
181      warn "ERROR:  Cannot backup $config_file.\n";
182      return undef;
183    } else {
184      print "Backed up config to $config_file.bak.boottool.\n";
185    }
186
187    open(CONFIG, ">$config_file")
188      || warn ("ERROR:  Can't open config file.\n") && return undef;
189    print CONFIG join("",@config);
190    close(CONFIG);
191    return 0;
192  } else {
193    print join("",@config) if $self->debug() > 2;
194    warn "WARNING:  You do not have write access to $config_file.\n";
195    return 1;
196  }
197}
198
199
200# Parse config into array of hashes
201
202sub _info {
203  my $self=shift;
204
205  return undef unless $self->_check_config();
206  my @config=@{$self->{config}};
207
208  # remove garbarge - comments, blank lines
209  @config=grep(!/^#|^\n/, @config);
210
211  my %matches = ( default => '^\s*default[\s+\=]+(\S+)',
212                  timeout => '^\s*timeout[\s+\=]+(\S+)',
213                  title   => '^\s*label[\s+\=]+(\S+)',
214                  root    => '^\s*root[\s+\=]+(\S+)',
215                  args    => '^\s*append[\s+\=]+(.*)',
216                  initrd  => '^\s*initrd[\s+\=]+(\S+)',
217                );
218
219  my @sections;
220  my $index=0;
221  foreach (@config) {
222    if ($_ =~ /^\s*(image|other)[\s+\=]+(\S+)/i) {
223      $index++;
224      $sections[$index]{'kernel'} = $2;
225    }
226    foreach my $key (keys %matches) {
227      if ($_ =~ /$matches{$key}/i) {
228        $sections[$index]{$key} = $1;
229	$sections[$index]{$key} =~ s/\"|\'//g if ($key eq 'args');
230      }
231    }
232  }
233
234  # sometimes config doesn't have a default, so goes to first
235  if (!(defined $sections[0]{'default'})) {
236    $sections[0]{'default'} = '0';
237
238  # if default is label name, we need position
239  } else {
240    foreach my $index (1..$#sections) {
241      if ($sections[$index]{'title'} eq $sections[0]{'default'}) {
242        $sections[0]{'default'} = $index-1;
243        last;
244      }
245    }
246  }
247
248  # if still no valid default, set to first
249  if ( $sections[0]{'default'} !~ m/^\d+$/ ) {
250    $sections[0]{'default'} = 0;
251  }
252
253  # return array of hashes
254  return @sections;
255}
256
257
258# Determine current default kernel
259
260sub get_default {
261  my $self = shift;
262
263  print ("Getting default.\n") if $self->debug()>1;
264  return undef unless $self->_check_config();
265
266  my @sections = $self->_info();
267  my $default = $sections[0]{'default'};
268  if ($default =~ /^\d+$/) {
269      return 0+$default;
270  }
271
272}
273
274# Find the template entry.
275sub get_template {
276  my ($self) = @_;
277
278  print ("Getting template.\n") if $self->debug()>1;
279  return undef unless $self->_check_config();
280
281  my @sections = $self->_info();
282  my $default = $sections[0]{'default'} + 1;
283
284  if (defined $sections[$default]{'kernel'}) {
285    return $default - 1;
286  }
287  for ($default = 1; $default <= $#sections; $default++) {
288    if (defined $sections[$default]->{'kernel'}) {
289      return $default - 1;
290    }
291  }
292  return undef;
293}
294
295
296# Set new default kernel
297
298sub set_default {
299  my $self=shift;
300  my $newdefault=shift;
301
302  print ("Setting default.\n") if $self->debug()>1;
303
304  return undef unless defined $newdefault;
305  return undef unless $self->_check_config();
306
307  my @config=@{$self->{config}};
308  my @sections=$self->_info();
309
310  # if not a number, do title lookup
311  if ($newdefault !~ /^\d+$/) {
312    $newdefault = $self->_lookup($newdefault);
313  }
314
315  my $kcount = $#sections-1;
316  if ((!defined $newdefault) || ($newdefault < 0) || ($newdefault > $kcount)) {
317    warn "ERROR:  Enter a default between 0 and $kcount.\n";
318    return undef;
319  }
320
321  # convert position to title
322  $newdefault = $sections[++$newdefault]{title};
323
324  foreach my $index (0..$#config) {
325    if ($config[$index] =~ /^\s*default/i) {
326      $config[$index] = "default=$newdefault	# set by $0\n";
327      last;
328    }
329  }
330  @{$self->{config}} = @config;
331}
332
333
334# Add new kernel to config
335
336sub add {
337  my $self=shift;
338  my %param=@_;
339
340  print ("Adding kernel.\n") if $self->debug()>1;
341
342  if (!defined $param{'add-kernel'} && defined $param{'kernel'}) {
343    $param{'add-kernel'} = $param{'kernel'};
344  } elsif (!defined $param{'add-kernel'} || !defined $param{'title'}) {
345    warn "ERROR:  kernel path (--add-kernel), title (--title) required.\n";
346    return undef;
347  } elsif (!(-f "$param{'add-kernel'}")) {
348    warn "ERROR:  kernel $param{'add-kernel'} not found!\n";
349    return undef;
350  } elsif (defined $param{'initrd'} && !(-f "$param{'initrd'}")) {
351    warn "ERROR:  initrd $param{'initrd'} not found!\n";
352    return undef;
353  }
354
355  return undef unless $self->_check_config();
356
357  # remove title spaces and truncate if more than 15 chars
358  $param{title} =~ s/\s+//g;
359  $param{title} = substr($param{title}, 0, 15) if length($param{title}) > 15;
360
361  my @sections=$self->_info();
362
363  # check if title already exists
364  if (defined $self->_lookup($param{title})) {
365    warn ("WARNING:  Title already exists.\n");
366    if (defined $param{force}) {
367      $self->remove($param{title});
368    } else {
369      return undef;
370    }
371  }
372
373  my @config = @{$self->{config}};
374  @sections=$self->_info();
375
376  # Use default kernel to fill in missing info
377  my $default=$self->get_template();
378  $default++;
379
380  foreach my $p ('args', 'root') {
381    if (! defined $param{$p}) {
382      $param{$p} = $sections[$default]{$p};
383    }
384  }
385
386  # use default entry to determine if path (/boot) should be removed
387  my $bootpath = $sections[$default]{'kernel'};
388  $bootpath =~ s@[^/]*$@@;
389
390  $param{'add-kernel'} =~ s@^/boot/@$bootpath@;
391  $param{'initrd'} =~ s@^/boot/@$bootpath@ unless !defined $param{'initrd'};
392
393  my @newkernel;
394  push (@newkernel, "image=$param{'add-kernel'}\n", "\tlabel=$param{title}\n");
395  push (@newkernel, "\tappend=\"$param{args}\"\n") if defined $param{args};
396  push (@newkernel, "\tinitrd=$param{initrd}\n") if defined $param{initrd};
397  push (@newkernel, "\troot=$param{root}\n") if defined $param{root};
398  ##push (@newkernel, "\tread-only\n\n");
399
400  if (!defined $param{position} || $param{position} !~ /end|\d+/) {
401    $param{position}=0;
402  }
403
404  my @newconfig;
405  if ($param{position}=~/end/ || $param{position} >= $#sections) {
406    $param{position}=$#sections;
407    push (@newconfig,@config);
408    if ($newconfig[$#newconfig] =~ /\S/) {
409      push (@newconfig, "\n");
410    }
411    push (@newconfig,@newkernel);
412  } else {
413    my $index=0;
414    foreach (@config) {
415      if ($_ =~ /^\s*(image|other)/i) {
416        if ($index==$param{position}) {
417          push (@newconfig, @newkernel);
418        }
419        $index++;
420      }
421      push (@newconfig, $_);
422    }
423  }
424
425  @{$self->{config}} = @newconfig;
426
427  if (defined $param{'make-default'}) {
428    $self->set_default($param{position});
429  }
430}
431
432
433# Update kernel args
434
435sub update {
436  my $self=shift;
437  my %params=@_;
438
439  print ("Updating kernel.\n") if $self->debug()>1;
440
441  if (!defined $params{'update-kernel'} || (!defined $params{'args'} && !defined $params{'remove-args'})) {
442    warn "ERROR:  kernel position or title (--update-kernel) and args (--args or --remove-args) required.\n";
443    return undef;
444  }
445
446  return undef unless $self->_check_config();
447
448  my @config = @{$self->{config}};
449  my @sections=$self->_info();
450
451  # if not a number, do title lookup
452  if ($params{'update-kernel'} !~ /^\d+$/) {
453    $params{'update-kernel'} = $self->_lookup($params{'update-kernel'});
454  }
455
456  my $kcount = $#sections-1;
457  if ($params{'update-kernel'} !~ /^\d+$/ || $params{'update-kernel'} < 0 || $params{'update-kernel'} > $kcount) {
458    warn "ERROR:  Enter a default between 0 and $kcount.\n";
459    return undef;
460  }
461
462  my $index=-1;
463  foreach (@config) {
464    if ($_ =~ /^\s*(image|other)/i) {
465      $index++;
466    }
467    if ($index==$params{'update-kernel'}) {
468      if ($_ =~ /(^\s*append[\s\=]+)(.*)\n/i) {
469        my $append = $1;
470        my $args = $2;
471        $args =~ s/\"|\'//g;
472	$args = $self->_build_args($args, $params{'remove-args'}, $params{'args'});
473        if ($_ eq "$append\"$args\"\n") {
474          warn "WARNING:  No change made to args.\n";
475          return undef;
476        } else {
477          $_ = "$append\"$args\"\n";
478        }
479        next;
480      }
481    }
482  }
483  @{$self->{config}} = @config;
484}
485
486
487# Remove kernel from config
488
489sub remove {
490  my $self=shift;
491  my $position=shift;
492  my @newconfig;
493
494  return undef unless defined $position;
495  return undef unless $self->_check_config();
496
497  my @config=@{$self->{config}};
498  my @sections=$self->_info();
499
500  if ($position=~/^end$/i) {
501    $position=$#sections-1;
502  } elsif ($position=~/^start$/i) {
503    $position=0;
504  }
505
506  print ("Removing kernel $position.\n") if $self->debug()>1;
507
508  # remove based on title
509  if ($position !~ /^\d+$/) {
510    my $removed=0;
511    for (my $index=$#sections; $index > 0; $index--) {
512      if (defined $sections[$index]{title} && $position eq $sections[$index]{title}) {
513        $removed++ if $self->remove($index-1);
514      }
515    }
516    if (! $removed) {
517      warn "ERROR:  No kernel with specified title.\n";
518      return undef;
519    }
520
521  # remove based on position
522  } elsif ($position =~ /^\d+$/) {
523
524    if ($position < 0 || $position > $#sections) {
525      warn "ERROR:  Enter a position between 0 and $#sections.\n";
526      return undef;
527    }
528
529    my $index=-1;
530    foreach (@config) {
531      if ($_ =~ /^\s*(image|other|title)/i) {
532        $index++
533      }
534      # add everything to newconfig, except removed kernel (keep comments)
535      if ($index != $position || $_ =~ /^#/) {
536        push (@newconfig, $_)
537      }
538    }
539    @{$self->{config}} = @newconfig;
540
541
542    # if we removed the default, set new default to first
543    $self->set_default(0) if $position == $sections[0]{'default'};
544
545    print "Removed kernel $position.\n";
546    return 1;
547
548  } else {
549    warn "WARNING:  problem removing entered position.\n";
550    return undef;
551  }
552
553}
554
555
556# Print info from config
557
558sub print_info {
559  my $self=shift;
560  my $info=shift;
561
562  return undef unless defined $info;
563  return undef unless $self->_check_config();
564
565  print ("Printing config info.\n") if $self->debug()>1;
566
567  my @config=@{$self->{config}};
568  my @sections=$self->_info();
569
570  my ($start,$end);
571  if ($info =~ /default/i) {
572    $start=$end=$self->get_default()
573  } elsif ($info =~ /all/i) {
574    $start=0; $end=$#sections-1
575  } elsif ($info =~ /^\d+/) {
576    $start=$end=$info
577  } else {
578    my $index = $self->_lookup($info);
579    if (!defined $index) {
580      warn "ERROR:  input should be: #, default, all, or a valid title.\n";
581      return undef;
582    }
583    $start=$end=$index;
584  }
585
586  if ($start < 0 || $end > $#sections-1) {
587    warn "ERROR:  No kernels with that index.\n";
588    return undef;
589  }
590
591  for my $index ($start..$end) {
592    print "\nindex\t: $index\n";
593    $index++;
594    foreach ( sort keys(%{$sections[$index]}) ) {
595      print "$_\t: $sections[$index]{$_}\n";
596    }
597  }
598}
599
600
601# Set/get debug level
602
603sub debug {
604  my $self=shift;
605  if (@_) {
606      $self->{debug} = shift;
607  }
608  return $self->{debug} || 0;
609}
610
611# Get a bootloader entry as a hash to edit or update.
612sub read_entry {
613  my $self=shift;
614  my $entry=shift;
615
616  if ($entry !~ /^\d+$/) {
617    $entry = $self->_lookup($entry);
618  }
619  my @sections=$self->_info();
620
621  my $index = $entry + 1;
622  if ((defined $sections[$index]{'title'})) {
623    $self->{'entry'}->{'index'} = $index;
624    foreach my $key ( keys %{$sections[$index]} ){
625      $self->{'entry'}->{'data'}->{ $key } = $sections[$index]{$key};
626    }
627    return $self->{'entry'}->{'data'};
628  } else {
629    return undef;
630  }
631}
632
633# Basic check for valid config
634
635sub _check_config {
636  my $self=shift;
637
638  print ("Verifying config.\n") if $self->debug()>3;
639
640  if ($#{$self->{config}} < 5) {
641    warn "ERROR:  you must read a valid config file first.\n";
642    return undef;
643  }
644  return 1;
645}
646
647
648# lookup position using title
649
650sub _lookup {
651  my $self=shift;
652  my $title=shift;
653
654  unless ( defined $title ){ return undef; }
655
656  my @sections=$self->_info();
657
658  for my $index (1..$#sections) {
659    my $tmp = $sections[$index]{title};
660    if (defined $tmp and $title eq $tmp) {
661      return $index-1;
662    }
663  }
664  return undef;
665}
666
667sub _build_args {
668  my ($self, $args, $toremove, $toadd) = @_;
669
670  if (defined $toremove) {
671    my $base;
672    foreach my $remove (split(' ', $toremove)) {
673      $base = $remove; $base =~ s/\=.*//;
674      $args =~ s/(^|\s+)$base(\=\S+|\s+|$)/$1/ig;
675    }
676  }
677
678  if (defined $toadd) {
679    my $base;
680    foreach my $add (split(' ', $toadd)) {
681      $base = $add; $base =~ s/\=.*//;
682      if (!($args =~ s/(^|\s+)$base(\=\S+)?(\s+|$)/$1$add$3/ig)) {
683        $args .= " $add";
684      }
685    }
686  }
687
688  $args =~ s/\s+/ /g;
689  return $args;
690}
691
692
693=head1 AUTHOR
694
695Jason N., Open Source Development Labs, Engineering Department <eng@osdl.org>
696
697=head1 COPYRIGHT
698
699Copyright (C) 2006 Open Source Development Labs
700All Rights Reserved.
701
702This script is free software; you can redistribute it and/or modify it
703under the same terms as Perl itself.
704
705=head1 SEE ALSO
706
707L<boottool>, L<Linux::Bootloader::Grub>, L<Linux::Bootloader::Lilo>,
708L<Linux::Bootloader::Elilo>, L<Linux::Bootloader::Yaboot>
709
710=cut
711
712
7131;
714package Linux::Bootloader::Detect;
715
716=head1 NAME
717
718Linux::Bootloader::Detect - detects the bootloader and architecture of the system.
719
720=head1 SYNOPSIS
721
722Attempts to determine the bootloader by checking for configuration files
723for grub, lilo, elilo and yaboot then searching the master boot record
724for GRUB, LILO, ELILO and YABOOT.
725
726Determines the architecture by running uname -m.
727
728=head1 DESCRIPTION
729
730To attempt to discover the bootloader being used by the system
731detect_bootloader first calls detect_bootloader_from_conf attempts to locate
732/boot/grub/menu.lst, /etc/lilo.conf, /boot/efi/elilo.conf and
733/etc/yaboot.conf and returns the corresponding bootloader name. If
734either undef of multiple are returned because no configuration files or
735multiple configuration files were found detect_bootloader calls
736detect_bootloader_from_mbr which generates a list of all devices accessable from
737the /dev directory reading in the first 512 bytes from each hd and sd
738device using head then redirects the output to grep to determine if
739"GRUB", "LILO", "ELILO" or "YABOOT" is present returning the
740corresponding value if exactly one mbr on the system contained a
741bootloader or multiple if more than one was found and undef if none were
742found. detect_bootloader returns either grub, lilo, elilo, yaboot or
743undef.
744
745To attempt to discover the architecture of the system
746detect_architecture makes a uname -m system call returning x86, ppc,
747ia64 or undef.
748
749=head1 FUNCTIONS
750
751=cut
752
753use strict;
754use warnings;
755
756use vars qw( $VERSION );
757
758=head3 detect_architecture([style])
759
760Input:
761Output: string
762
763This function determines the architecture by calling uname -m.  By
764default it will report back exactly what uname -m reports, but if you
765specify a "style", detect_architecture will do some mappings.  Possible
766styles include:
767
768 Style    Example return values (not an exhaustive list...)
769 [none]   i386, i686, sparc, sun4u, ppc64, s390x, x86_64, parisc64
770 linux    i386, i386, sparc, sparc, ppc64, s390,  x86_64, parisc
771 gentoo    x86,  x86, sparc, sparc, ppc64,         amd64, hppa
772
773Returns undef on error.
774
775=cut
776
777sub detect_architecture {
778    my $arch_style = shift || 'uname';
779
780    my $arch;
781    if ($arch_style eq 'linux') {
782        $arch = `uname -m | sed -e s/i.86/i386/ -e s/sun4u/sparc64/ -e s/arm.*/arm/ -e s/sa110/arm/ -e s/s390x/s390/ -e s/parisc64/parisc/`;
783        chomp $arch;
784    } elsif ($arch_style eq 'gentoo') {
785        $arch = `uname -m | sed -e s/i.86/x86/ -e s/sun4u/sparc/ -e s/arm.*/arm/ -e s/sa110/arm/ -e s/x86_64/amd64/ -e s/sparc.*/sparc/ -e s/parisc.*/hppa/`;
786        chomp $arch;
787    } else {
788        $arch = `uname -m`;
789        chomp $arch;
790    }
791    return $arch;
792}
793
794=head3 detect_os_vendor()
795
796Input:
797Output: string
798
799This function determines the OS vendor (linux distribution breed).
800
801Return values: "Red Hat", "Fedora", "SUSE", "Ubuntu", "Debian", or
802"Unknown" if none of the predefined patterns could be found on the
803issue file.
804
805=cut
806
807sub detect_os_vendor {
808    my $vendor = "";
809    my $issue_file = '/etc/issue';
810    if ( not system("egrep 'Red Hat' $issue_file") ){
811       $vendor = 'Red Hat';
812    } elsif ( not system("egrep 'Fedora' $issue_file") ){
813       $vendor = 'Fedora';
814    } elsif ( not system("egrep 'SUSE' $issue_file") ){
815       $vendor = 'SUSE';
816    } elsif ( not system("egrep 'Ubuntu' $issue_file") ){
817       $vendor = 'Ubuntu';
818    } elsif ( not system("egrep 'Debian' $issue_file") ){
819       $vendor = 'Debian';
820    } else {
821       $vendor = 'Unknown';
822    }
823    return $vendor;
824}
825
826=head3 detect_bootloader(['device1', 'device2', ...])
827
828Input:  devices to detect against (optional)
829Output: string
830
831This function attempts to determine the bootloader being used on the
832system by first checking for conf files and then falling back to check
833the master boot record.
834
835Possible return values:
836
837    grub        grub was determined to be the bootloader in use
838    lilo        lilo was determined to be is the bootloader in use
839    elilo       elilo was determined to be the bootloader in use
840    yaboot      yaboot was determined to be the bootloader in use
841    undef       it was impossible to determine which bootloader was being used
842                due either to configuration files for multiple bootloaders or
843                bootloader on multiple hard disks
844
845=cut
846
847sub detect_bootloader {
848    return detect_bootloader_from_conf(@_)
849        || detect_bootloader_from_mbr(@_);
850}
851
852=head2 detect_bootloader_from_conf()
853
854Detects bootloaders by the presence of config files.  This is not as
855reliable of a mechanism as looking in the MBR, but tends to be
856significantly faster.
857
858If called in list context, it will return a list of the bootloaders that
859it found.
860
861If called in scalar context and only a single bootloader config file is
862present it will return the name of that bootloader.  Otherwise, if
863multiple (or no) bootloaders are detected, it will return undef.
864
865=cut
866
867sub detect_bootloader_from_conf {
868    my @boot_loader = ();
869
870    my %boot_list = ( grub   => '/boot/grub/menu.lst',
871                      lilo   => '/etc/lilo.conf',
872                      elilo  => '/etc/elilo.conf',
873                      yaboot => '/etc/yaboot.conf',
874                      zipl   => '/etc/zipl.conf',
875                      );
876
877    foreach my $key ( sort keys %boot_list ) {
878        if ( -f $boot_list{$key} ) {
879            push ( @boot_loader, $key );
880        }
881    }
882
883    if (wantarray()) {
884        return @boot_loader;
885    } elsif (@boot_loader == 1) {
886        return pop( @boot_loader );
887    } elsif (@boot_loader == 2) {
888	if ($boot_loader[0] eq 'lilo' && $boot_loader[1] eq 'yaboot') {
889		return 'lilo';
890	}
891    }
892
893    if (scalar(@boot_loader) > 1) {
894        warn "Warning: Multiple bootloader configs; not certain which is in use.\n";
895	warn "         " . join(' ', @boot_loader) . "\n";
896    }
897    return undef;
898}
899
900=head2 detect_bootloader_from_mbr([@devices])
901
902Detects the bootloader by scanning the master boot record (MBR) of the
903specified devices (or all devices if not indicated).
904
905The device arguments must be relative to the /dev/ directory.  I.e.,
906('hda', 'sdb', 'cdroms/cdrom0', etc.)
907
908=cut
909
910sub detect_bootloader_from_mbr {
911    my @filelist = @_;
912    my @boot_loader = ();
913
914    my %map = (
915        "GRUB"   => 'grub',
916        "LILO"   => 'lilo',
917        "EFI"    => 'elilo',
918        "yaboot" => 'yaboot',
919    );
920
921    if ( ! @filelist && opendir( DIRH, "/sys/block" ) ) {
922        @filelist = grep { /^[sh]d.$/ } readdir(DIRH);
923        closedir(DIRH);
924    }
925
926    foreach my $dev ( @filelist ) {
927        if ( -b "/dev/$dev" ) {
928            my $strings = `dd if=/dev/$dev bs=512 count=1 2>/dev/null`;
929            if ($?) {
930                warn "Error:  Could not read MBR on /dev/$dev (are you root?)\n";
931            } else {
932                $strings = `echo $strings | strings`;
933                foreach my $loader (keys %map) {
934                    if ($strings =~ /$loader/ms) {
935                        push @boot_loader, $map{$loader};
936                    }
937                }
938            }
939        }
940    }
941
942    if (wantarray()) {
943        # Show them all
944        return @boot_loader;
945    } elsif (@boot_loader == 1) {
946        # Found exactly one
947        return pop @boot_loader;
948    } elsif (@boot_loader == 2) {
949        # This is the Lilo/Grub exception
950        # Grub on MBR with previous Lilo install
951        # Are they lilo and grub in that order?
952        if ($boot_loader[0] eq 'lilo' and $boot_loader[1] eq 'grub'){
953            warn "Warning:  Grub appears to be used currently, but Lilo was in past.\n";
954            return $boot_loader[1];
955        }
956    } else {
957        warn "Warning: Multiple MBR's present; not certain which is in use.\n";
958	warn "         " . join(' ', @boot_loader) . "\n";
959        return undef;
960    }
961
962    # Either none or too many to choose from
963    return undef;
964}
965
9661;
967
968=head1 AUTHOR
969
970Open Source Development Labs, Engineering Department <eng@osdl.org>
971
972=head1 COPYRIGHT
973
974Copyright (C) 2006 Open Source Development Labs
975All Rights Reserved.
976
977This script is free software; you can redistribute it and/or modify it
978under the same terms as Perl itself.
979
980=head1 SEE ALSO
981
982L<Linux::Bootloader>
983
984=cut
985
986package Linux::Bootloader::Elilo;
987
988=head1 NAME
989
990Linux::Bootloader::Elilo - Parse and modify ELILO configuration files.
991
992=head1 SYNOPSIS
993
994
995	my $bootloader = Linux::Bootloader::Elilo->new();
996	my $config_file='/etc/elilo.conf';
997
998	$bootloader->read($config_file)
999
1000	# add a kernel
1001	$bootloader->add(%hash)
1002
1003	# remove a kernel
1004	$bootloader->remove(2)
1005
1006	# set new default
1007	$bootloader->set_default(1)
1008
1009	$bootloader->write($config_file)
1010
1011
1012=head1 DESCRIPTION
1013
1014This module provides functions for working with ELILO configuration files.
1015
1016	Adding a kernel:
1017	- add kernel at start, end, or any index position.
1018	- kernel path and title are required.
1019	- root, kernel args, initrd are optional.
1020	- any options not specified are copied from default.
1021	- remove any conflicting kernels if force is specified.
1022
1023	Removing a kernel:
1024	- remove by index position
1025	- or by title/label
1026
1027
1028=head1 FUNCTIONS
1029
1030Also see L<Linux::Bootloader> for functions available from the base class.
1031
1032=head2 new()
1033
1034	Creates a new Linux::Bootloader::Elilo object.
1035
1036=head2 install()
1037
1038        Attempts to install bootloader.
1039        Takes: nothing.
1040        Returns: undef on error.
1041
1042=cut
1043
1044
1045use strict;
1046use warnings;
1047
1048@Linux::Bootloader::Elilo::ISA = qw(Linux::Bootloader);
1049use base 'Linux::Bootloader';
1050
1051
1052use vars qw( $VERSION );
1053
1054
1055sub _set_config_file {
1056    my $self=shift;
1057    $self->{'config_file'}='/etc/elilo.conf';
1058}
1059
1060
1061### ELILO functions ###
1062
1063
1064# Run command to install bootloader
1065
1066sub install {
1067  my $self=shift;
1068
1069  my $elilo = '';
1070  $elilo = '/sbin/elilo' if (-f '/sbin/elilo');
1071  $elilo = '/usr/sbin/elilo' if (-f '/usr/sbin/elilo');
1072  if ($elilo ne '') {
1073      system($elilo);
1074      if ($? != 0) {
1075	warn ("ERROR:  Failed to run elilo.\n") && return undef;
1076      }
1077  }
1078  return 1;
1079}
1080
1081# Set kernel to be booted once
1082
1083sub boot_once {
1084    my $self=shift;
1085    my $label = shift;
1086
1087    return undef unless defined $label;
1088
1089    $self->read( '/etc/elilo.conf' );
1090    my @config=@{$self->{config}};
1091
1092    if ( ! grep( /^checkalt/i, @config ) ) {
1093        warn("ERROR:  Failed to set boot-once.\n");
1094        warn("Please add 'checkalt' to global config.\n");
1095        return undef;
1096    }
1097
1098    my @sections = $self->_info();
1099    my $position = $self->_lookup($label);
1100    $position++;
1101    my $efiroot = `grep ^EFIROOT /usr/sbin/elilo | cut -d '=' -f 2`;
1102    chomp($efiroot);
1103
1104    my $kernel = $efiroot . $sections[$position]{kernel};
1105    my $root = $sections[$position]{root};
1106    my $args = $sections[$position]{args};
1107
1108    #system( "/usr/sbin/eliloalt", "-d" );
1109    if ( system( "/usr/sbin/eliloalt", "-s", "$kernel root=$root $args" ) ) {
1110        warn("ERROR:  Failed to set boot-once.\n");
1111        warn("1) Check that EFI var support is compiled into kernel.\n");
1112        warn("2) Verify eliloalt works.  You may need to patch it to support sysfs EFI vars.\n");
1113        return undef;
1114    }
1115    return 1;
1116}
1117
1118
11191;
1120
1121
1122=head1 AUTHOR
1123
1124Open Source Development Labs, Engineering Department <eng@osdl.org>
1125
1126=head1 COPYRIGHT
1127
1128Copyright (C) 2006 Open Source Development Labs
1129All Rights Reserved.
1130
1131This script is free software; you can redistribute it and/or modify it
1132under the same terms as Perl itself.
1133
1134=head1 SEE ALSO
1135
1136L<Linux::Bootloader>
1137
1138=cut
1139
1140
1141package Linux::Bootloader::Grub;
1142
1143=head1 NAME
1144
1145Linux::Bootloader::Grub - Parse and modify GRUB configuration files.
1146
1147=head1 SYNOPSIS
1148
1149
1150        my $config_file='/boot/grub/menu.lst';
1151	$bootloader = Linux::Bootloader::Grub->new($config_file);
1152
1153        $bootloader->read();
1154
1155	# add a kernel
1156	$bootloader->add(%hash)
1157
1158	# remove a kernel
1159	$bootloader->remove(2)
1160
1161	# print config info
1162	$bootloader->print_info('all')
1163
1164	# set new default
1165	$bootloader->set_default(1)
1166
1167        $bootloader->write();
1168
1169
1170=head1 DESCRIPTION
1171
1172This module provides functions for working with GRUB configuration files.
1173
1174	Adding a kernel:
1175	- add kernel at start, end, or any index position.
1176	- kernel path and title are required.
1177	- root, kernel args, initrd, savedefault, module are optional.
1178	- any options not specified are copied from default.
1179	- remove any conflicting kernels first if force is specified.
1180
1181	Removing a kernel:
1182	- remove by index position
1183	- or by title/label
1184
1185
1186=head1 FUNCTIONS
1187
1188Also see L<Linux::Bootloader> for functions available from the base class.
1189
1190=head2 new()
1191
1192	Creates a new Linux::Bootloader::Grub object.
1193
1194=head2 _info()
1195
1196	Parse config into array of hashes.
1197	Takes: nothing.
1198	Returns: array of hashes containing config file options and boot entries,
1199                 undef on error.
1200
1201=head2 set_default()
1202
1203	Set new default kernel.
1204	Takes: integer or string, boot menu position or title.
1205	Returns: undef on error.
1206
1207=head2 add()
1208
1209	Add new kernel to config.
1210	Takes: hash containing kernel path, title, etc.
1211	Returns: undef on error.
1212
1213=head2 update()
1214
1215        Update args of an existing kernel entry.
1216        Takes: hash containing args and entry to update.
1217        Returns: undef on error.
1218
1219=head2 install()
1220
1221        Prints message on how to re-install grub.
1222        Takes: nothing.
1223        Returns: nothing.
1224
1225=head2 update_main_options()
1226
1227	This updates or adds a general line anywhere before the first 'title' line.
1228	it is called with the 'update' and 'option' options, when no 'update-kernel'
1229	is specified.
1230
1231=head2 boot_once()
1232
1233	This is a special case of using 'fallback'.   This function makes the current
1234	default the fallback kernel and sets the passed argument to be the default
1235	kernel which saves to the fallback kernel after booting.  The file
1236	'/boot/grub/default' is created if it does not exist.
1237
1238	This only works with grub versions 0.97 or better.
1239
1240=head2 _get_bootloader_version()
1241
1242        Prints detected grub version.
1243        Takes: nothing.
1244        Returns: nothing.
1245
1246=cut
1247
1248use strict;
1249use warnings;
1250
1251@Linux::Bootloader::Grub::ISA = qw(Linux::Bootloader);
1252use base 'Linux::Bootloader';
1253
1254
1255use vars qw( $VERSION );
1256
1257
1258sub _set_config_file {
1259    my $self=shift;
1260    $self->{'config_file'}='/boot/grub/menu.lst';
1261}
1262
1263
1264### GRUB functions ###
1265
1266# Parse config into array of hashes
1267
1268sub _info {
1269  my $self=shift;
1270
1271  return undef unless $self->_check_config();
1272
1273  my @config=@{$self->{config}};
1274  @config=grep(!/^#|^\n/, @config);
1275
1276  my %matches = ( default => '^\s*default\s*\=*\s*(\S+)',
1277		  timeout => '^\s*timeout\s*\=*\s*(\S+)',
1278		  fallback => '^\s*fallback\s*\=*\s*(\S+)',
1279		  kernel => '^\s*kernel\s+(\S+)',
1280		  root 	=> '^\s*kernel\s+.*\s+.*root=(\S+)',
1281		  args 	=> '^\s*kernel\s+\S+\s+(.*)\n',
1282		  boot 	=> '^\s*root\s+(.*)',
1283		  initrd => '^\s*initrd\s+(.*)',
1284		  savedefault => '^\s*savedefault\s+(.*)',
1285		  module      => '^\s*module\s+(.+)',
1286		);
1287
1288  my @sections;
1289  my $index=0;
1290  foreach (@config) {
1291      if ($_ =~ /^\s*title\s+(.*)/i) {
1292        $index++;
1293        $sections[$index]{title} = $1;
1294      }
1295      foreach my $key (keys %matches) {
1296        if ($_ =~ /$matches{$key}/i) {
1297          $key .= '2' if exists $sections[$index]{$key};
1298          $sections[$index]{$key} = $1;
1299          if ($key eq 'args') {
1300	    $sections[$index]{$key} =~ s/root=\S+\s*//i;
1301	    delete $sections[$index]{$key} if ($sections[$index]{$key} !~ /\S/);
1302          }
1303        }
1304      }
1305  }
1306
1307  # sometimes config doesn't have a default, so goes to first
1308  if (!(defined $sections[0]{'default'})) {
1309    $sections[0]{'default'} = '0';
1310
1311  # if default is 'saved', read from grub default file
1312  } elsif ($sections[0]{'default'} =~ m/^saved$/i) {
1313    open(DEFAULT_FILE, '/boot/grub/default')
1314      || warn ("ERROR:  cannot read grub default file.\n") && return undef;
1315    my @default_config = <DEFAULT_FILE>;
1316    close(DEFAULT_FILE);
1317    $default_config[0] =~ /^(\d+)/;
1318    $sections[0]{'default'} = $1;
1319  }
1320
1321  # return array of hashes
1322  return @sections;
1323}
1324
1325
1326# Set new default kernel
1327
1328sub set_default {
1329  my $self=shift;
1330  my $newdefault=shift;
1331
1332  return undef unless defined $newdefault;
1333  return undef unless $self->_check_config();
1334
1335  my @config=@{$self->{config}};
1336  my @sections=$self->_info();
1337
1338  # if not a number, do title lookup
1339  if ($newdefault !~ /^\d+$/ && $newdefault !~ m/^saved$/) {
1340    $newdefault = $self->_lookup($newdefault);
1341    return undef unless (defined $newdefault);
1342  }
1343
1344  my $kcount = $#sections-1;
1345  if ($newdefault !~ m/saved/) {
1346    if (($newdefault < 0) || ($newdefault > $kcount)) {
1347      warn "ERROR:  Enter a default between 0 and $kcount.\n";
1348      return undef;
1349    }
1350  }
1351
1352  foreach my $index (0..$#config) {
1353
1354    if ($config[$index] =~ /(^\s*default\s*\=*\s*)\d+/i) {
1355      $config[$index] = "$1$newdefault\n";
1356      last;
1357    } elsif ($config[$index] =~ /^\s*default\s*\=*\s*saved/i) {
1358      my @default_config;
1359      my $default_config_file='/boot/grub/default';
1360
1361      open(DEFAULT_FILE, $default_config_file)
1362        || warn ("ERROR:  cannot open default file.\n") && return undef;
1363      @default_config = <DEFAULT_FILE>;
1364      close(DEFAULT_FILE);
1365
1366      if ($newdefault eq 'saved') {
1367          warn "WARNING:  Setting new default to '0'\n";
1368          $newdefault = 0;
1369      }
1370
1371      $default_config[0] = "$newdefault\n";
1372
1373      open(DEFAULT_FILE, ">$default_config_file")
1374        || warn ("ERROR:  cannot open default file.\n") && return undef;
1375      print DEFAULT_FILE join("",@default_config);
1376      close(DEFAULT_FILE);
1377      last;
1378    }
1379  }
1380  @{$self->{config}} = @config;
1381}
1382
1383
1384# Add new kernel to config
1385
1386sub add {
1387  my $self=shift;
1388  my %param=@_;
1389
1390  print ("Adding kernel.\n") if $self->debug()>1;
1391
1392  if (!defined $param{'add-kernel'} || !defined $param{'title'}) {
1393    warn "ERROR:  kernel path (--add-kernel), title (--title) required.\n";
1394    return undef;
1395  } elsif (!(-f "$param{'add-kernel'}")) {
1396    warn "ERROR:  kernel $param{'add-kernel'} not found!\n";
1397    return undef;
1398  } elsif (defined $param{'initrd'} && !(-f "$param{'initrd'}")) {
1399    warn "ERROR:  initrd $param{'initrd'} not found!\n";
1400    return undef;
1401  }
1402
1403  return undef unless $self->_check_config();
1404
1405  my @sections=$self->_info();
1406
1407  # check if title already exists
1408  if (defined $self->_lookup($param{title})) {
1409    warn ("WARNING:  Title already exists.\n");
1410    if (defined $param{force}) {
1411      $self->remove($param{title});
1412    } else {
1413      return undef;
1414    }
1415  }
1416
1417  my @config = @{$self->{config}};
1418  @sections=$self->_info();
1419
1420  # Use default kernel to fill in missing info
1421  my $default=$self->get_template();
1422  $default++;
1423
1424  foreach my $p ('args', 'root', 'boot', 'savedefault') {
1425    if (! defined $param{$p}) {
1426      $param{$p} = $sections[$default]{$p};
1427    }
1428  }
1429
1430  # use default entry to determine if path (/boot) should be removed
1431  my $bootpath = $sections[$default]{'kernel'};
1432  $bootpath =~ s@[^/]*$@@;
1433
1434  $param{'add-kernel'} =~ s@^/boot/@$bootpath@;
1435  $param{'initrd'} =~ s@^/boot/@$bootpath@ unless !defined $param{'initrd'};
1436
1437  my @newkernel;
1438  push(@newkernel, "title\t$param{title}\n") if defined $param{title};
1439  push(@newkernel, "\troot $param{boot}\n") if defined $param{boot};
1440
1441  my $line;
1442  if ( defined $param{xen} ) {
1443      $line = "\tkernel $sections[$default]{kernel}";
1444      $line .= " $sections[$default]{root}" if defined $sections[$default]{root};
1445      $line .= " $sections[$default]{args}" if defined $sections[$default]{args};
1446      push( @newkernel, "$line\n" );
1447      push( @newkernel, "\tinitrd $sections[$default]{'initrd'}\n" ) if defined $sections[$default]{'initrd'};
1448      $line = "\tmodule $param{'add-kernel'}" if defined $param{'add-kernel'};
1449      $line .= " root=$param{root}"    if defined $param{root};
1450      $line .= " $param{args}"         if defined $param{args};
1451      push( @newkernel, "$line\n" );
1452      push( @newkernel, "\tmodule $param{initrd}\n" ) if defined $param{initrd};
1453  } else {
1454      $line = "\tkernel $param{'add-kernel'}" if defined $param{'add-kernel'};
1455      $line .= " root=$param{root}"    if defined $param{root};
1456      $line .= " $param{args}"         if defined $param{args};
1457      push( @newkernel, "$line\n" );
1458      push( @newkernel, "\tinitrd $param{initrd}\n" ) if defined $param{initrd};
1459  }
1460
1461  push(@newkernel, "\tsavedefault $param{savedefault}\n") if defined $param{savedefault};
1462
1463  foreach my $module (@{$param{'module'}}) {
1464     push(@newkernel, "\tmodule " . $module . "\n");
1465  }
1466
1467  push(@newkernel, "\n");
1468
1469  if (!defined $param{position} || $param{position} !~ /end|\d+/) {
1470    $param{position}=0
1471  }
1472
1473  my @newconfig;
1474  if ($param{position}=~/end/ || $param{position} >= $#sections) {
1475    $param{position}=$#sections;
1476    push (@newconfig,@config);
1477    if ($newconfig[$#newconfig] =~ /\S/) {
1478      push (@newconfig, "\n");
1479    }
1480    push (@newconfig,@newkernel);
1481  } else {
1482    my $index=0;
1483    foreach (@config) {
1484      if ($_ =~ /^\s*title/i) {
1485        if ($index==$param{position}) {
1486          push (@newconfig, @newkernel);
1487        }
1488        $index++;
1489      }
1490      push (@newconfig, $_);
1491    }
1492  }
1493
1494  @{$self->{config}} = @newconfig;
1495
1496  if (defined $param{'make-default'} || defined $param{'boot-once'}) {
1497    $self->set_default($param{position});
1498  }
1499  print "Added: $param{'title'}.\n";
1500}
1501
1502
1503# Update kernel args
1504
1505sub update {
1506  my $self=shift;
1507  my %params=@_;
1508
1509  print ("Updating kernel.\n") if $self->debug()>1;
1510
1511  if (defined $params{'option'} && !defined $params{'update-kernel'}) {
1512    return $self->update_main_options(%params);
1513  } elsif (!defined $params{'update-kernel'} || (!defined $params{'args'} && !defined $params{'remove-args'} && !defined $params{'option'})) {
1514    warn "ERROR:  kernel position or title (--update-kernel) and args (--args or --remove-args) required.\n";
1515    return undef;
1516  }
1517
1518  return undef unless $self->_check_config();
1519
1520#  my @config = @{$self->{config}};
1521  my @sections=$self->_info();
1522
1523  # if not a number, do title lookup
1524  if (defined $params{'update-kernel'} and $params{'update-kernel'} !~ /^\d+$/) {
1525    $params{'update-kernel'} = $self->_lookup($params{'update-kernel'});
1526  }
1527
1528  my $kcount = $#sections-1;
1529  if ($params{'update-kernel'} !~ /^\d+$/ || $params{'update-kernel'} < 0 || $params{'update-kernel'} > $kcount) {
1530    warn "ERROR:  Enter a default between 0 and $kcount.\n";
1531    return undef;
1532  }
1533
1534  my $kregex = '(^\s*kernel\s+\S+)(.*)';
1535  $kregex = '(^\s*module\s+\S+vmlinuz\S+)(.*)' if defined $params{'xen'};
1536
1537  my $index=-1;
1538  my $config_line = -1;
1539  my $line = '';
1540  foreach $line (@{$self->{config}}) {
1541    $config_line = $config_line + 1;
1542    if ($line =~ /^\s*title/i) {
1543      $index++;
1544    }
1545    if ($index==$params{'update-kernel'}) {
1546      if (defined $params{'args'} or defined $params{'remove-args'}){
1547        if ( $line =~ /$kregex/i ) {
1548          my $kernel = $1;
1549          my $args = $self->_build_args($2, $params{'remove-args'}, $params{'args'});
1550          if ($line eq $kernel . $args . "\n") {
1551            warn "WARNING:  No change made to args.\n";
1552            return undef;
1553          } else {
1554            $line = $kernel . $args . "\n";
1555          }
1556          next;
1557        }
1558      } elsif (defined $params{'option'}){
1559        foreach my $val ( keys %params){
1560          if ($line =~ m/^\s*$val.*/i) {
1561            splice @{$self->{config}},$config_line,1,"$val $params{$val}\n";
1562            delete $params{$val};
1563            $config_line += 1;
1564          }
1565        }
1566      }
1567    } elsif ($index > $params{'update-kernel'}){
1568      last;
1569    }
1570  }
1571  # Add any leftover parameters
1572  delete $params{'update-kernel'};
1573  if (defined $params{'option'}){
1574    delete $params{'option'};
1575    $config_line -= 1;
1576    foreach my $val ( keys %params){
1577      splice @{$self->{config}},$config_line,0,"$val $params{$val}\n";
1578      $config_line += 1;
1579    }
1580  }
1581}
1582
1583
1584# Run command to install bootloader
1585
1586sub install {
1587  my $self=shift;
1588  my $device;
1589
1590  warn "Re-installing grub is currently unsupported.\n";
1591  warn "If you really need to re-install grub, use 'grub-install <device>'.\n";
1592  return undef;
1593
1594  #system("grub-install $device");
1595  #if ($? != 0) {
1596  #  warn ("ERROR:  Failed to run grub-install.\n") && return undef;
1597  #}
1598  #return 1;
1599}
1600
1601
1602sub update_main_options{
1603  my $self=shift;
1604  my %params=@_;
1605  delete $params{'option'};
1606  foreach my $val (keys %params){
1607    my $x=0;
1608    foreach my $line ( @{$self->{config}} ) {
1609      # Replace
1610      if ($line =~ m/^\s*$val/) {
1611	splice (@{$self->{config}},$x,1,"$val $params{$val}\n");
1612        last;
1613      }
1614      # Add
1615      if ($line =~ /^\s*title/i) {
1616        #  This is a new option, add it before here
1617        print "Your option is not in current configuration.  Adding.\n";
1618	splice @{$self->{config}},$x,0,"$val $params{$val}\n";
1619        last;
1620      }
1621      $x+=1;
1622    }
1623  }
1624}
1625
1626
1627sub boot_once {
1628  my $self=shift;
1629  my $entry_to_boot_once = shift;
1630  my $detected_os_vendor = Linux::Bootloader::Detect::detect_os_vendor();
1631
1632  unless ( $entry_to_boot_once ) { print "No kernel\n"; return undef;}
1633  $self->read();
1634  my $default=$self->get_default();
1635
1636  if ( $self->_get_bootloader_version() < 0.97 ){
1637     warn "This function works for grub version 0.97 and up.  No action taken.  \nUpgrade, then re-try.\n";
1638     return undef;
1639  }
1640
1641  if ( $detected_os_vendor eq "Red Hat" or $detected_os_vendor eq "Fedora" ) {
1642    # if not a number, do title lookup
1643    if ( $entry_to_boot_once !~ /^\d+$/ ) {
1644      $entry_to_boot_once = $self->_lookup($entry_to_boot_once);
1645      return undef unless ( defined $entry_to_boot_once );
1646    }
1647
1648    return `echo "savedefault --default=$entry_to_boot_once" --once | grub --batch`;
1649  } else {
1650  if ( $default == $self->_lookup($entry_to_boot_once)){
1651     warn "The default and once-boot kernels are the same.  No action taken.  \nSet default to something else, then re-try.\n";
1652     return undef;
1653  }
1654
1655  $self->set_default('saved');
1656  if ( ! -f '/boot/grub/default' ){
1657     open FH, '>/boot/grub/default';
1658     my $file_contents="default
1659#
1660#
1661#
1662#
1663#
1664#
1665#
1666#
1667#
1668#
1669# WARNING: If you want to edit this file directly, do not remove any line
1670# from this file, including this warning. Using `grub-set-default\' is
1671# strongly recommended.
1672";
1673    print FH $file_contents;
1674    close FH;
1675  }
1676  $self->set_default( "$entry_to_boot_once" );
1677  $self->update( 'option'=>'','fallback' => $default );
1678  $self->update( 'update-kernel'=>"$entry_to_boot_once",'option'=>'','savedefault' => 'fallback' );
1679  $self->update( 'update-kernel'=>"$default",'option'=>'', 'savedefault' => '' );
1680  $self->write();
1681  }
1682}
1683
1684sub _get_bootloader_version {
1685  my $self = shift;
1686  return `grub --version | sed 's/grub (GNU GRUB //' | sed 's/)//'`;
1687}
1688
1689
16901;
1691
1692
1693=head1 AUTHOR
1694
1695Open Source Development Labs, Engineering Department <eng@osdl.org>
1696
1697=head1 COPYRIGHT
1698
1699Copyright (C) 2006 Open Source Development Labs
1700All Rights Reserved.
1701
1702This script is free software; you can redistribute it and/or modify it
1703under the same terms as Perl itself.
1704
1705=head1 SEE ALSO
1706
1707L<Linux::Bootloader>
1708
1709=cut
1710
1711package Linux::Bootloader::Lilo;
1712
1713=head1 NAME
1714
1715Linux::Bootloader::Lilo - Parse and modify LILO configuration files.
1716
1717=head1 SYNOPSIS
1718
1719
1720	my $bootloader = Linux::Bootloader::Lilo->new();
1721	my $config_file='/etc/lilo.conf';
1722
1723	$bootloader->read($config_file)
1724
1725	# add a kernel
1726	$bootloader->add(%hash)
1727
1728	# remove a kernel
1729	$bootloader->remove(2)
1730
1731	# set new default
1732	$bootloader->set_default(1)
1733
1734	$bootloader->write($config_file)
1735
1736
1737=head1 DESCRIPTION
1738
1739This module provides functions for working with LILO configuration files.
1740
1741	Adding a kernel:
1742	- add kernel at start, end, or any index position.
1743	- kernel path and title are required.
1744	- root, kernel args, initrd are optional.
1745	- any options not specified are copied from default.
1746	- remove any conflicting kernels if force is specified.
1747
1748	Removing a kernel:
1749	- remove by index position
1750	- or by title/label
1751
1752
1753=head1 FUNCTIONS
1754
1755Also see L<Linux::Bootloader> for functions available from the base class.
1756
1757=head2 new()
1758
1759	Creates a new Linux::Bootloader::Lilo object.
1760
1761=head2 install()
1762
1763        Attempts to install bootloader.
1764        Takes: nothing.
1765        Returns: undef on error.
1766
1767=head2 boot-once()
1768
1769        Attempts to set a kernel as default for one boot only.
1770        Takes: string.
1771        Returns: undef on error.
1772
1773=cut
1774
1775
1776use strict;
1777use warnings;
1778
1779@Linux::Bootloader::Lilo::ISA = qw(Linux::Bootloader);
1780use base 'Linux::Bootloader';
1781
1782
1783use vars qw( $VERSION );
1784
1785
1786sub _set_config_file {
1787    my $self=shift;
1788    $self->{'config_file'}='/etc/lilo.conf';
1789}
1790
1791
1792
1793### LILO functions ###
1794
1795
1796# Run command to install bootloader
1797
1798sub install {
1799  my $self=shift;
1800
1801  system("/sbin/lilo");
1802  if ($? != 0) {
1803    warn ("ERROR:  Failed to run lilo.\n") && return undef;
1804  }
1805  return 1;
1806}
1807
1808
1809# Set kernel to be booted once
1810
1811sub boot_once {
1812  my $self=shift;
1813  my $label=shift;
1814
1815  return undef unless defined $label;
1816
1817  if (system("/sbin/lilo","-R","$label")) {
1818    warn ("ERROR:  Failed to set boot-once.\n") && return undef;
1819  }
1820  return 1;
1821}
1822
1823
18241;
1825
1826
1827=head1 AUTHOR
1828
1829Open Source Development Labs, Engineering Department <eng@osdl.org>
1830
1831=head1 COPYRIGHT
1832
1833Copyright (C) 2006 Open Source Development Labs
1834All Rights Reserved.
1835
1836This script is free software; you can redistribute it and/or modify it
1837under the same terms as Perl itself.
1838
1839=head1 SEE ALSO
1840
1841L<Linux::Bootloader>
1842
1843=cut
1844
1845package Linux::Bootloader::Yaboot;
1846
1847=head1 NAME
1848
1849Linux::Bootloader::Yaboot - Parse and modify YABOOT configuration files.
1850
1851=head1 SYNOPSIS
1852
1853
1854	my $bootloader = Linux::Bootloader::Yaboot->new();
1855	my $config_file='/etc/yaboot.conf';
1856
1857	$bootloader->read($config_file)
1858
1859	# add a kernel
1860	$bootloader->add(%hash)
1861
1862	# remove a kernel
1863	$bootloader->remove(2)
1864
1865	# set new default
1866	$bootloader->set_default(1)
1867
1868	$bootloader->write($config_file)
1869
1870
1871=head1 DESCRIPTION
1872
1873This module provides functions for working with YABOOT configuration files.
1874
1875	Adding a kernel:
1876	- add kernel at start, end, or any index position.
1877	- kernel path and title are required.
1878	- root, kernel args, initrd are optional.
1879	- any options not specified are copied from default.
1880	- remove any conflicting kernels if force is specified.
1881
1882	Removing a kernel:
1883	- remove by index position
1884	- or by title/label
1885
1886
1887=head1 FUNCTIONS
1888
1889Also see L<Linux::Bootloader> for functions available from the base class.
1890
1891=head2 new()
1892
1893	Creates a new Linux::Bootloader::Yaboot object.
1894
1895=head2 install()
1896
1897        Attempts to install bootloader.
1898        Takes: nothing.
1899        Returns: undef on error.
1900
1901=cut
1902
1903
1904use strict;
1905use warnings;
1906
1907@Linux::Bootloader::Yaboot::ISA = qw(Linux::Bootloader);
1908use base 'Linux::Bootloader';
1909
1910
1911use vars qw( $VERSION );
1912
1913
1914sub _set_config_file {
1915    my $self=shift;
1916    $self->{'config_file'}='/etc/yaboot.conf';
1917}
1918
1919### YABOOT functions ###
1920
1921
1922# Run command to install bootloader
1923
1924sub install {
1925	my $self=shift;
1926	my $cmd="";
1927	# ybin currently returns an error even when it succeeds, but by
1928	# dumb luck ybin -v does the right thing
1929	if (-f "/usr/sbin/ybin") {
1930		$cmd="/usr/sbin/ybin -v > /dev/null";
1931	} elsif (-f "/sbin/ybin") {
1932		$cmd="/sbin/ybin -v > /dev/null";
1933	} else {
1934		print("Not installing bootloader.\n");
1935	}
1936
1937	system($cmd);
1938	if ( $? != 0 ) {
1939		warn("ERROR:  Failed to run ybin.\n") && return undef;
1940	}
1941	return 1;
1942}
1943
1944
19451;
1946
1947
1948=head1 AUTHOR
1949
1950IBM, Linux Technology Centre, Andy Whitcroft <apw@uk.ibm.com>
1951
1952=head1 COPYRIGHT
1953
1954Copyright (C) 2006 IBM Corperation
1955All Rights Reserved.
1956
1957This script is free software; you can redistribute it and/or modify it
1958under the same terms as Perl itself.
1959
1960=head1 SEE ALSO
1961
1962L<Linux::Bootloader>
1963
1964=cut
1965
1966package Linux::Bootloader::Zipl;
1967
1968=head1 NAME
1969
1970Linux::Bootloader::Zipl - Parse and modify ZIPL configuration files.
1971
1972=cut
1973
1974use strict;
1975use warnings;
1976
1977@Linux::Bootloader::Zipl::ISA = qw(Linux::Bootloader);
1978use base 'Linux::Bootloader';
1979
1980
1981use vars qw( $VERSION );
1982
1983
1984sub _set_config_file {
1985    my $self=shift;
1986    $self->{'config_file'}='/etc/zipl.conf';
1987}
1988
1989
1990### ZIPL functions ###
1991
1992# Parse config into array of hashes
1993sub _info {
1994  my $self=shift;
1995
1996  return undef unless $self->_check_config();
1997
1998  my @config=@{$self->{config}};
1999  @config=grep(!/^#|^\s*$/, @config);
2000
2001  my %matches = (
2002		  target => '^\s*target\s*=\s*(.*)',
2003		  kernel => '^\s*image\s*=\s*(\S+)',
2004		  initrd => '^\s*ramdisk\s*=\s*(.*)',
2005		  args => '^\s*parameters\s*=\s*"?\s*(.*[^"])"?',
2006		);
2007
2008  my %sect_title;
2009  my $menu_name;
2010  my $title;
2011  my @sections;
2012  foreach (@config) {
2013    chomp($_);
2014
2015    # Note the menu and switch mode.
2016    if ($_ =~ /^:(menu\S*)/) {
2017      $menu_name = $1;
2018
2019    # An entry starts [name]
2020    } elsif ($_ =~ /^\s*\[(\S+)\]/i) {
2021      $title = $1;
2022      $sect_title{$title}{title} = $title;
2023    }
2024
2025    # Decode the entry fields
2026    if (!defined $menu_name) {
2027      foreach my $key (keys %matches) {
2028	if ($_ =~ /$matches{$key}/i) {
2029	  $key .= '2' if exists $sect_title{$title}{$key};
2030	  $sect_title{$title}{$key} = $1;
2031	}
2032      }
2033
2034    # This is the menu, pull it in
2035    } else {
2036        # If this is an entry specified copy entry in to the result.
2037	if ($_ =~ /^\s+(\d+)\s*=\s*(\S*)/) {
2038	  $sections[$1] = $sect_title{$2};
2039
2040	# record all the other attributes here, pick out the default
2041	# if we see it.
2042	} else {
2043	  if ($_ =~ /^\s+(\S+)\s*=\s*(.*\S)\s*/) {
2044	    $sections[0]{$1} = $2;
2045	  }
2046	}
2047     }
2048  }
2049  $sections[0]{'menu'} = $menu_name;
2050  if (defined $sections[0]{'default'}) {
2051    $sections[0]{'default'}--;
2052  }
2053
2054  # sometimes config doesn't have a default, so goes to first
2055  if (!(defined $sections[0]{'default'})) {
2056    $sections[0]{'default'} = '0';
2057
2058  # if default is label name, we need position
2059  } elsif ($sections[0]{'default'} !~ m/^\d+$/) {
2060    foreach my $index (1..$#sections) {
2061      if ($sections[$index]{'title'} eq $sections[0]{'default'}) {
2062        $sections[0]{'default'} = $index-1;
2063        last;
2064      }
2065    }
2066    $sections[0]{'default'} = 0 if (!defined $sections[0]{'default'});
2067  }
2068
2069  # return array of hashes
2070  return @sections;
2071}
2072
2073# Set new default kernel
2074
2075sub set_default {
2076  my $self=shift;
2077  my $newdefault=shift;
2078
2079  return undef unless defined $newdefault;
2080  return undef unless $self->_check_config();
2081
2082  my @config=@{$self->{config}};
2083  my @sections=$self->_info();
2084
2085  # if not a number, do title lookup
2086  if ($newdefault !~ /^\d+$/) {
2087    $newdefault = $self->_lookup($newdefault);
2088    return undef unless (defined $newdefault);
2089  }
2090
2091  my $kcount = $#sections-1;
2092  if (($newdefault < 0) || ($newdefault > $kcount)) {
2093    warn "ERROR: Enter a default between 0 and $kcount.\n";
2094    return undef;
2095  }
2096
2097  # Look up the actual title of this section.
2098  my $title = $sections[$newdefault + 1]{'title'};
2099
2100  # Look through the config file for the specifier,
2101  # note there are two, one the name and one the number
2102  # go figure.  Note that ZIPL numbering is 1..N.
2103  foreach my $index (0..$#config) {
2104    if ($config[$index] =~ /(^\s*default\s*\=*\s*)\d+\s*$/i) {
2105      $config[$index] = $1 . ($newdefault + 1) . "\n";
2106
2107    } elsif ($config[$index] =~ /(^\s*default\s*\=*\s*)/i) {
2108      $config[$index] = "$1$title\n";
2109    }
2110  }
2111  @{$self->{config}} = @config;
2112}
2113
2114
2115# Add new kernel to config
2116sub add {
2117  my $self=shift;
2118  my %param=@_;
2119
2120  print ("Adding kernel.\n") if $self->debug()>1;
2121
2122  if (!defined $param{'add-kernel'} || !defined $param{'title'}) {
2123    warn "ERROR:  kernel path (--add-kernel), title (--title) required.\n";
2124    return undef;
2125  } elsif (!(-f "$param{'add-kernel'}")) {
2126    warn "ERROR:  kernel $param{'add-kernel'} not found!\n";
2127    return undef;
2128  } elsif (defined $param{'initrd'} && !(-f "$param{'initrd'}")) {
2129    warn "ERROR:  initrd $param{'initrd'} not found!\n";
2130    return undef;
2131  }
2132
2133  return undef unless $self->_check_config();
2134
2135  my @sections=$self->_info();
2136
2137  # check if title already exists
2138  if (defined $self->_lookup($param{title})) {
2139    warn ("WARNING:  Title already exists.\n");
2140    if (defined $param{force}) {
2141      $self->remove($param{title});
2142    } else {
2143      return undef;
2144    }
2145  }
2146
2147  my @config = @{$self->{config}};
2148  @sections=$self->_info();
2149
2150  # Use default kernel to fill in missing info
2151  my $default=$self->get_template();
2152  $default++;
2153
2154  foreach my $p ('args', 'target') {
2155    if (! defined $param{$p}) {
2156      $param{$p} = $sections[$default]{$p};
2157    }
2158  }
2159
2160  # use default entry to determine if path (/boot) should be removed
2161  my $bootpath = $sections[$default]{'kernel'};
2162  $bootpath =~ s@[^/]*$@@;
2163
2164  $param{'add-kernel'} =~ s@^/boot/@$bootpath@;
2165  $param{'initrd'} =~ s@^/boot/@$bootpath@ unless !defined $param{'initrd'};
2166
2167  my $line;
2168  my @newkernel;
2169  push(@newkernel, "[$param{'title'}]\n");
2170  push(@newkernel, "\ttarget=$param{'target'}\n") if (defined $param{'target'});
2171  push(@newkernel, "\timage=$param{'add-kernel'}\n");
2172  push(@newkernel, "\tramdisk=$param{'initrd'}\n") if (defined $param{'initrd'});
2173  $line = '';
2174  $line .= "root=$param{root} " if (defined $param{'root'});
2175  $line .= "$param{args} " if (defined $param{'args'});
2176  chop($line);
2177  push(@newkernel, "\tparameters=\"$line\"\n");
2178
2179  push(@newkernel, "\n");
2180
2181  if (!defined $param{position} || $param{position} !~ /end|\d+/) {
2182    $param{position} = 0;
2183  }
2184
2185  my @newconfig;
2186  my $index=0;
2187  my $menu=0;
2188  my @list;
2189  foreach (@config) {
2190    if ($_ !~ /^\s*\[defaultboot]/i && $_ =~ /^\s*\[(\S+)]/i) {
2191      if ($param{'position'} ne 'end' && $index == $param{position}) {
2192	push(@newconfig, @newkernel);
2193        push(@list, $param{'title'});
2194      }
2195      $index++;
2196      push(@list, $1);
2197
2198    } elsif (/^:menu\S*/) {
2199      if ($param{'position'} eq 'end' || $index < $param{'position'}) {
2200	push(@newconfig, @newkernel);
2201        push(@list, $param{'title'});
2202	$param{position} = $index;
2203      }
2204      # Rebuild the menu entries.
2205      push(@newconfig, $_);
2206      for (my $n = 0; $n <= $#list; $n++) {
2207        push(@newconfig, "\t" . ($n+1) . "=$list[$n]\n");
2208      }
2209      $menu = 1;
2210      next;
2211    }
2212    if ($menu) {
2213      if (/^\s+\d+=/) {
2214	next;
2215      } else {
2216	$menu = 0;
2217      }
2218    }
2219    push(@newconfig, $_);
2220  }
2221
2222  @{$self->{config}} = @newconfig;
2223
2224  if (defined $param{'make-default'} || defined $param{'boot-once'}) {
2225    $self->set_default($param{position});
2226  }
2227  print "Added: $param{'title'}.\n";
2228}
2229
2230
2231# Remove a kernel from config
2232sub remove {
2233  my $self=shift;
2234  my $position=shift;
2235
2236  return undef unless defined $position;
2237  return undef unless $self->_check_config();
2238
2239  my @config=@{$self->{config}};
2240  my @sections=$self->_info();
2241  my $default = $self->get_default();
2242
2243  if ($position=~/^end$/i) {
2244    $position=$#sections-1;
2245  } elsif ($position=~/^start$/i) {
2246    $position=0;
2247  }
2248
2249  print ("Removing kernel $position.\n") if $self->debug()>1;
2250
2251  # if not a number, do title lookup
2252  if ($position !~ /^\d+$/) {
2253    $position = $self->_lookup($position);
2254  }
2255  if ($position !~ /^\d+$/) {
2256    warn "ERROR: $position: should be # or title\n";
2257    return undef;
2258  }
2259
2260  my $title = $sections[$position + 1]{'title'};
2261
2262  my $keep = 1;
2263  my @newconfig;
2264  my @list;
2265  my $index = 0;
2266  my $menu;
2267  foreach (@config) {
2268    if ($_ !~ /^\s*\[defaultboot]/i && $_ =~ /^\s*\[(\S+)]/i) {
2269      if ($index == $position) {
2270        $keep = 0;
2271      } else {
2272        push(@list, $1);
2273	$keep = 1;
2274      }
2275      $index++;
2276
2277    } elsif (/^:menu\S*/) {
2278      # Rebuild the menu entries.
2279      push(@newconfig, $_);
2280      for (my $n = 0; $n <= $#list; $n++) {
2281        push(@newconfig, "\t" . ($n+1) . "=$list[$n]\n");
2282      }
2283      $menu = 1;
2284      $keep = 1;
2285      next;
2286    }
2287    if ($menu) {
2288      if (/^\s+\d+=/) {
2289	next;
2290      } else {
2291	$menu = 0;
2292      }
2293    }
2294    push(@newconfig, $_) if ($keep);
2295  }
2296
2297  @{$self->{config}} = @newconfig;
2298
2299  # Update the default.
2300  my $new = $default;
2301  if ($default == $position) {
2302    $new = 0;
2303  } elsif ($default > $position) {
2304    $new = $default - 1;
2305  }
2306  if ($default != $new) {
2307    $self->set_default($new);
2308  }
2309
2310  print "Removed: $title\n";
2311}
2312
2313
2314# Update kernel args
2315sub update {
2316  my $self=shift;
2317  my %params=@_;
2318
2319  print ("Updating kernel.\n") if $self->debug()>1;
2320
2321  if (defined $params{'option'} && !defined $params{'update-kernel'}) {
2322    return $self->update_main_options(%params);
2323  } elsif (!defined $params{'update-kernel'} || (!defined $params{'args'} && !defined $params{'remove-args'} && !defined $params{'option'})) {
2324    warn "ERROR:  kernel position or title (--update-kernel) and args (--args or --remove-args) required.\n";
2325    return undef;
2326  }
2327
2328  return undef unless $self->_check_config();
2329
2330#  my @config = @{$self->{config}};
2331  my @sections=$self->_info();
2332
2333  # if not a number, do title lookup
2334  if (defined $params{'update-kernel'} and $params{'update-kernel'} !~ /^\d+$/) {
2335    $params{'update-kernel'} = $self->_lookup($params{'update-kernel'});
2336  }
2337
2338  my $kcount = $#sections-1;
2339  if ($params{'update-kernel'} !~ /^\d+$/ || $params{'update-kernel'} < 0 || $params{'update-kernel'} > $kcount) {
2340    warn "ERROR: Enter a default between 0 and $kcount.\n";
2341    return undef;
2342  }
2343
2344  # Convert to a title to find the relevant section.
2345  my $title = $sections[$params{'update-kernel'} + 1]{'title'};
2346
2347  my $seen = '';
2348  my $config_line = -1;
2349  my $line = '';
2350  foreach $line (@{$self->{config}}) {
2351    $config_line = $config_line + 1;
2352    if ($line =~ /^\s*\[(\S+)]/i) {
2353      $seen = $1;
2354    }
2355    if ($title eq $seen) {
2356      if (defined $params{'args'} or defined $params{'remove-args'}){
2357        if ($line =~ /^\s*parameters="(.*[^"])"/i) {
2358	  my $oargs = $1;
2359	  my $args = $self->_build_args($oargs, $params{'remove-args'}, $params{'args'});
2360          if ($args eq $oargs) {
2361            warn "WARNING:  No change made to args.\n";
2362            return undef;
2363          }
2364	  # Note that updating line updates the _real_ lines in @config.
2365	  $line = "\tparameters=\"$args\"\n";
2366          next;
2367        }
2368      } elsif (defined $params{'option'}){
2369        foreach my $val ( keys %params){
2370          if ($line =~ m/^\s*$val.*/i) {
2371            splice @{$self->{config}},$config_line,1,"$val $params{$val}\n";
2372            delete $params{$val};
2373            $config_line += 1;
2374          }
2375        }
2376      }
2377    }
2378  }
2379  # Add any leftover parameters
2380  delete $params{'update-kernel'};
2381  if (defined $params{'option'}){
2382    delete $params{'option'};
2383    $config_line -= 1;
2384    foreach my $val ( keys %params){
2385      splice @{$self->{config}},$config_line,0,"\t$val $params{$val}\n";
2386      $config_line += 1;
2387    }
2388  }
2389}
2390
2391
2392# Run command to install bootloader
2393sub install {
2394  my $self=shift;
2395  my $device;
2396
2397  my @sections=$self->_info();
2398
2399  warn "ZIPL: needs to run zipl -m $sections[0]{'menu'}\n";
2400  system("/sbin/zipl -m $sections[0]{'menu'}");
2401  if ($? != 0) {
2402    warn ("ERROR:  Failed to run grub-install.\n") && return undef;
2403  }
2404  return 1;
2405}
2406
2407
2408sub update_main_options{
2409  # XXX: the main options are probabally those on the menu object.
2410  die "ERROR: unable to update main options\n";
2411}
2412
2413
2414sub boot_once {
2415  warn "ZIPL does not support boot-once\n";
2416  return undef;
2417}
2418
24191;
2420
2421=head1 AUTHOR
2422
2423Open Source Development Labs, Engineering Department <eng@osdl.org>
2424
2425=head1 COPYRIGHT
2426
2427Copyright (C) 2006 Open Source Development Labs
2428All Rights Reserved.
2429
2430This script is free software; you can redistribute it and/or modify it
2431under the same terms as Perl itself.
2432
2433=head1 SEE ALSO
2434
2435L<Linux::Bootloader>
2436
2437=cut
2438
2439#!/usr/bin/perl -I ../lib
2440
2441use lib '../lib';
2442use Getopt::Long;
2443use Pod::Usage;
2444
2445
2446my %params;
2447
2448GetOptions(
2449           \%params,
2450           "bootloader-probe",      # Prints the bootloader in use on the system
2451           "arch-probe:s",          # Prints the arch of the system
2452           "bootloader=s",
2453           "config_file=s",
2454           "add-kernel=s",
2455           "remove-kernel=s",
2456           "update-kernel=s",
2457           "title=s",
2458           "args=s",
2459           "remove-args=s",
2460           "initrd=s",
2461           "root=s",
2462           "savedefault=s",
2463           "position=s",
2464           "info=s",
2465           "debug=i",
2466           "set-default=s",
2467           "make-default",
2468           "force",
2469           "boot-once",
2470           "install",
2471	   "module=s@",
2472           "default",
2473           "help",
2474           "man",
2475           "version|V",
2476           "xen",
2477           ) or pod2usage(-verbose => 1, -exitstatus => 0);
2478
2479pod2usage(-verbose => 2, -exitstatus => 0) if ($params{man});
2480pod2usage(-verbose => 1, -exitstatus => 0) if ($params{help});
2481pod2usage(-verbose => 0, -exitstatus => 0) if ! %params;
2482
2483if ($params{version}) {
2484    print "$0 version 1.1\n";
2485}
2486
2487### Bootloader / Arch Detection ###
2488
2489my $detected_bootloader;
2490my $detected_architecture;
2491
2492if (defined $params{'bootloader-probe'}) {
2493  our $opt_bootloader      = 0;
2494  $detected_bootloader = Linux::Bootloader::Detect::detect_bootloader()
2495    || warn "Could not detect bootloader\n";
2496  print "$detected_bootloader\n";
2497  exit 0;
2498} elsif (defined $params{'arch-probe'}) {
2499  our $opt_arch    = 0;
2500  $detected_architecture = Linux::Bootloader::Detect::detect_architecture( $params{'arch-probe'} )
2501    || warn "Could not detect architecture\n";
2502  print "$detected_architecture\n";
2503  exit 0;
2504} elsif (defined $params{bootloader}) {
2505  $detected_bootloader = $params{bootloader};
2506} else {
2507  #$detected_bootloader = 'grub';
2508  $detected_bootloader = Linux::Bootloader::Detect::detect_bootloader()
2509    || warn "Could not detect bootloader\n";
2510}
2511
2512
2513### Load Module ###
2514
2515my $bootloader;
2516if ($detected_bootloader =~ m/^(grub|elilo|lilo|yaboot|zipl)$/) {
2517  my $class = "Linux::Bootloader::" . "\u$detected_bootloader";
2518  eval "require $class";
2519  $bootloader = eval "new $class(\$params{config_file});";
2520
2521} else {
2522  die "ERROR: Bootloader $detected_bootloader not recognized!\n";
2523}
2524
2525
2526### Check Config ###
2527
2528if (! -r $bootloader->{config_file}) { die "Can't read config file.\n"; }
2529
2530if (defined $params{'debug'}) {
2531  $bootloader->debug($params{'debug'});
2532}
2533
2534if (defined $params{'install'}) {
2535  $bootloader->read();
2536  $bootloader->install() unless $detected_bootloader eq 'grub'
2537                             or $detected_bootloader eq 'pxe' ;
2538} elsif (defined $params{'add-kernel'}) {
2539  $bootloader->read();
2540  $bootloader->add(%params);
2541  $bootloader->write();
2542  $bootloader->install() unless $detected_bootloader eq 'grub';
2543
2544} elsif (defined $params{'remove-kernel'}) {
2545  $bootloader->read();
2546  $bootloader->remove($params{'remove-kernel'});
2547  $bootloader->write();
2548  $bootloader->install() unless $detected_bootloader eq 'grub';
2549
2550} elsif (defined $params{'update-kernel'}) {
2551  $bootloader->read();
2552  $bootloader->update(%params);
2553  $bootloader->write();
2554  $bootloader->install() unless $detected_bootloader eq 'grub';
2555
2556} elsif (defined $params{info}) {
2557  $bootloader->read();
2558  $bootloader->print_info($params{info});
2559
2560} elsif (defined $params{'set-default'}) {
2561  $bootloader->read();
2562  $bootloader->set_default($params{'set-default'});
2563  $bootloader->write();
2564  $bootloader->install() unless $detected_bootloader eq 'grub';
2565
2566} elsif (defined $params{'default'}) {
2567  $bootloader->read();
2568  print $bootloader->get_default() . "\n";
2569
2570} elsif (defined $params{'boot-once'} && defined $params{'title'}) {
2571  if ($detected_bootloader =~ /^lilo|^elilo|^grub/) {
2572    $bootloader->boot_once($params{title});
2573  } else {
2574    warn "WARNING: $detected_bootloader does not have boot-once support.\n";
2575    warn "Setting as default instead.\n";
2576    $bootloader->read();
2577    $bootloader->set_default($params{'title'});
2578    $bootloader->write();
2579  }
2580}
2581
2582
2583__END__
2584
2585
2586=head1 NAME
2587
2588boottool - tool for modifying bootloader configuration
2589
2590=head1 SYNOPSIS
2591
2592boottool [--bootloader-probe] [--arch-probe]
2593         [--add-kernel=<kernel_path>] [--title=<kernel_title>] [--position=<#|start|end>]
2594         [--root=<root_path>] [--args=<kernel_args>] [--initrd=<initrd_path>]
2595         [--make-default] [--force] [--boot-once] [--install]
2596         [--bootloader=<grub|lilo|elilo|yaboot|zipl>] [--config-file=</path/to/config>]
2597         [--remove-kernel=<#|title|start|end>] [--module=<module>]
2598         [--update-kernel=<#|title>] [--remove-args=<args>]
2599         [--info=<all|default|#>] [--default]
2600         [--help] [--debug=<0..5>] [--set-default=<#>]
2601
2602=head1 DESCRIPTION
2603
2604Boottool allows scripted modification of bootloader configuration files.
2605Grub, Lilo, Elilo, and Yaboot are currently supported.
2606When adding a kernel, any options not specified are copied from default.
2607
2608=head1 OPTIONS
2609
2610=head2 GENERAL OPTIONS
2611
2612These can be used with any of the commands to override defaults or
2613autodetection.  They are not typically needed.
2614
2615=over 8
2616
2617=item B<--bootloader>=I<string>
2618
2619Manually specify the bootloader to use.  By default, boottool will
2620automatically try to detect the bootloader being used.
2621
2622=item B<--config_file>=I<string>
2623
2624Specifies the path and name of the bootloader config file, overriding
2625autodetection of this file.
2626
2627=back
2628
2629=head2 INFORMATIONAL OPERATIONS
2630
2631These operations return information about the system, without making
2632alterations to any files.
2633
2634=over 8
2635
2636=item B<--bootloader-probe>
2637
2638Prints the bootloader in use on the system and exits.
2639
2640=item B<--arch-probe>
2641
2642Prints the arch of the system and exits.
2643
2644=item B<--info>=I<string>
2645
2646Display information about the bootloader entry at the given position number.
2647Also accepts 'all' or 'default'.
2648
2649=item B<--default>
2650
2651Prints the current default kernel for the bootloader.
2652
2653=back
2654
2655=head2 KERNEL OPERATIONS
2656
2657These operations result in modifications to system configuration files.
2658Only one of these operations may be called.  See KERNEL MODIFICATION
2659PARAMETERS (below) for specifying what the operations should do.
2660
2661=over 8
2662
2663=item B<--add-kernel>=I<string>
2664
2665Adds a new kernel with the given path.
2666
2667=item B<--update-kernel>=I<string>
2668
2669Updates an existing kernel with the given position number or title.
2670Used with --args or --remove-args.
2671
2672=item B<--module>=I<string>
2673
2674This option adds modules to the new kernel. It only works with Grub Bootloader.
2675For more module options just add another --module parameter
2676
2677=item B<--remove-kernel>=I<string>
2678
2679Removes the bootloader entry with the given position or title.
2680Also accepts 'start' or 'end'.
2681
2682=item B<--set-default>=I<integer>
2683
2684Updates the bootloader to set the default boot entry to given given
2685position or title.
2686
2687=item B<--boot-once>
2688
2689Causes the bootloader to boot the kernel specified by --title just one
2690time, then fall back to the default.  This option doesn't work
2691identically on all architectures.
2692
2693=back
2694
2695=head2 KERNEL MODIFICATION PARAMETERS
2696
2697These parameters can be used with the kernel operations listed above, to
2698specify how the operations should work.
2699
2700=over 8
2701
2702=item B<--title>=I<string>
2703
2704The title or label to use for the bootloader entry.
2705
2706=item B<--args>=I<string>
2707
2708Arguments to be passed to the kernel at boot.
2709
2710=item B<--remove-args>=I<string>
2711
2712Arguments to be removed from an existing entry.
2713Used with --update-kernel.
2714
2715=item B<--initrd>=I<string>
2716
2717The initrd image path to use in the bootloader entry.
2718
2719=item B<--root>=I<string>
2720
2721The device where the root partition is located.
2722
2723=item B<--savedefault>=I<string>
2724
2725The number to use in the savedefault section
2726
2727=item B<--position>=I<string>
2728
2729Insert bootloader entry at the given position number, counting from 0.
2730Also accepts 'start' or 'end'.  This is only useful when using the
2731--add-kernel operation.
2732
2733=item B<--make-default>
2734
2735Specifies that the bootloader entry being added should be set to the
2736default.
2737
2738=item B<--install>
2739
2740Causes bootloader to update and re-install the bootloader file.
2741
2742=back
2743
2744
2745=head2 OTHER OPTIONS
2746
2747=over 8
2748
2749=item B<-V, --version>
2750
2751Prints the version and exits.
2752
2753=item B<-h, --help>
2754
2755Prints a brief help message with option summary.
2756
2757=item B<--man>
2758
2759Prints a manual page (detailed help).  Same as `perdoc tgen`
2760
2761=item B<-D, --debug N>
2762
2763Prints debug messages.  This expects a numerical argument corresponding
2764to the debug message verbosity.
2765
2766=back
2767
2768=head1 PREREQUISITES
2769
2770C<Linux::Bootloader>
2771
2772C<Getopt::Long>
2773
2774C<Pod::Usage>
2775
2776=head1 COREQUISITES
2777
2778boottool works with any bootloader supported by Linux::Bootloader,
2779including the following:
2780
2781C<Lilo>
2782
2783C<Grub>
2784
2785C<Yaboot>
2786
2787C<Elilo>
2788
2789Obviously, at least one bootloader must be installed for this to be of
2790any use.  ;-)
2791
2792=head1 BUGS
2793
2794Send bug reports to L<http://sourceforge.net/projects/crucible/>
2795
2796=head1 VERSION
2797
27981.0
2799
2800=head1 SEE ALSO
2801
2802L<crucible>, L<WWW::PkgFind>, L<Test::Parser>, L<Linux::Distribution>
2803
2804=head1 AUTHOR
2805
2806Jason N.
2807
2808L<http://www.osdl.org/|http://www.osdl.org/>
2809
2810=head1 COPYRIGHT
2811
2812Copyright (C) 2006 Open Source Development Labs
2813All Rights Reserved.
2814
2815This script is free software; you can redistribute it and/or
2816modify it under the same terms as Perl itself.
2817
2818=head1 REVISION
2819
2820Revision: $Revision: 1.10 $
2821
2822=cut
2823