git.sur5r.net Git - bacula/rescue/blob - rescue/linux/cdrom/yaird-0.0.5/perl/main.pl

   1 #!@PERL@
   2 #
   3 # Main -- an exercise in initrd building
   4 #   Copyright (C) 2005  Erik van Konijnenburg
   5 #
   6 #   This program is free software; you can redistribute it and/or modify
   7 #   it under the terms of the GNU General Public License as published by
   8 #   the Free Software Foundation; either version 2 of the License, or
   9 #   (at your option) any later version.
  10 #
  11 #   This program is distributed in the hope that it will be useful,
  12 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #   GNU General Public License for more details.
  15 #
  16 #   You should have received a copy of the GNU General Public License
  17 #   along with this program; if not, write to the Free Software
  18 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19 #
  20 #
  21 #
  22 use strict;
  23 use warnings;
  24 use lib '@PERLDIR@';
  25
  26 use Getopt::Long;
  27 use Plan;
  28 use TestSet;
  29 use Pack;
  30
  31 my $appName = "@PACKAGE@";
  32 my $appVersion = "@VERSION@";
  33
  34
  35 #
  36 # go -- main program:
  37 # write an image to destination in specified format.
  38 # destination must not exist yet.
  39 # root is the blockdev to use as root after reboot, or undef for default.
  40 #
  41 sub go ($$$) {
  42         my ($format, $destination, $root) = @_;
  43         my $masterPlan = Plan::makePlan ($root);
  44         my $image = $masterPlan->expand ();
  45         Pack::package ($image, $format, $destination);
  46 }
  47
  48
  49 #
  50 # paranoia -- Random bits of -
  51 #
  52 sub paranoia {
  53         umask 077;
  54
  55         #
  56         # Perlsec(1) identifies the following as risky:
  57         #
  58         #       delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  59         #
  60         # but just scrapping the complete environment
  61         # seems to work nicely.
  62         #
  63         delete @ENV{keys %ENV};
  64         $ENV{'PATH'} = '/bin:/sbin:/usr/bin:/usr/sbin';
  65 }
  66
  67
  68 #
  69 # usage -- print invocation patterns of the application
  70 #
  71 sub usage {
  72         print <<"//";
  73
  74 $appName generates initrd images.
  75
  76 $appName --test [ version ]
  77         print an overview of system data, without writing anything to disk.
  78
  79 $appName --output dest --format format [ version ]
  80         generate an initrd image in 'dest', in the format 'format'.
  81
  82 Options:
  83    -h, -?, --help       print this help text and exit
  84    -V, --version        print version and exit (don't bother: $appVersion)
  85    -v, --verbose        print progress messages
  86    -d, --debug          detailed output
  87    -q, --quiet          don't print warning messages
  88    -o, --output dest    place result here
  89    -f, --format form    produce the image in this format,
  90                         valid values: directory, cramfs, cpio
  91    -r, --root blockdev  let initrd boot another block device as root
  92                         the blockdev must occur in fstab somewhere.
  93    -t, --test           print overview of system data,
  94                         used as basis for debugging.
  95
  96 //
  97 }
  98
  99
 100 #
 101 # main -- main program, argument processing
 102 #
 103 sub main {
 104         my ($opt_help, $opt_version,
 105                 $opt_verbose, $opt_quiet, $opt_debug,
 106                 $opt_format, $opt_output, $opt_root, $opt_test);
 107
 108         paranoia ();
 109         Base::setProgName ($appName);
 110
 111         my @warnings = ();
 112         {
 113                 #
 114                 # catch warnings during getopt, but not elsewhere.
 115                 # The idea is to let -? produce help without complaint,
 116                 # even if other args are broken.
 117                 #
 118                 local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
 119
 120                 Getopt::Long::Configure ("bundling");
 121                 my $result = GetOptions (
 122                         "h|help|?"      => \$opt_help,
 123                         "V|version"     => \$opt_version,
 124                         "v|verbose"     => \$opt_verbose,
 125                         "q|quiet"       => \$opt_quiet,
 126                         "d|debug"       => \$opt_debug,
 127                         "f|format=s"    => \$opt_format,
 128                         "o|output=s"    => \$opt_output,
 129                         "r|root=s"      => \$opt_root,
 130                         "t|test"        => \$opt_test,
 131                         );
 132         }
 133
 134         #
 135         # --help and --version processed without regard to other options,
 136         # exit without side effect.
 137         #
 138         if (defined ($opt_help)) {
 139                 usage ();
 140                 Base::bye();
 141         }
 142         if (defined ($opt_version)) {
 143                 Base::setVerbose (1);
 144                 Base::info ("version $appVersion");
 145                 Base::bye();
 146         }
 147
 148         #
 149         # Argument validation
 150         #
 151         for my $w (@warnings) {
 152                 # lazy: perhaps we could provide more info here?
 153                 Base::fatal ("$w");
 154         }
 155         if (defined ($opt_output) && defined ($opt_test)) {
 156                 Base::fatal "conflicting options --output and --test";
 157         }
 158         if (! defined ($opt_output) && ! defined ($opt_test)) {
 159                 Base::fatal "one of --output and --test must be given";
 160         }
 161         if (defined ($opt_output)) {
 162                 if (-e $opt_output) {
 163                         Base::fatal "destination $opt_output already exists";
 164                 }
 165                 if (! defined ($opt_format)) {
 166                         Base::fatal "option --output requires --format option";
 167                 }
 168                 if (! Pack::knownFormat ($opt_format)) {
 169                         Base::fatal "unknown --format argument: $opt_format";
 170                 }
 171
 172                 #
 173                 # Untaint -- is there a need for 'output' with an umlaut?
 174                 #
 175                 if ($opt_output !~ m!^([-_./[a-zA-Z0-9]+)$!) {
 176                         Base::fatal ("illegal character in output file name");
 177                 }
 178                 $opt_output = $1;
 179
 180                 if (defined ($opt_root)) {
 181                         # Untaint
 182                         if ($opt_root !~ m!^([-_./[a-zA-Z0-9]+)$!) {
 183                                 Base::fatal ("illegal character in root device name");
 184                         }
 185                         $opt_root = $1;
 186                 }
 187         }
 188         if (defined ($opt_test)) {
 189                 if (defined ($opt_format)) {
 190                         Base::fatal "conflicting options --test and --format";
 191                 }
 192                 if (defined ($opt_root)) {
 193                         Base::fatal "conflicting options --test and --root";
 194                 }
 195         }
 196         if ($#ARGV > 0) {
 197                 my $valid = $ARGV[0];
 198                 Base::fatal "extra arguments after $valid";
 199         }
 200
 201         #
 202         # All arguments validated; start processing.
 203         #
 204         if ($#ARGV == 0) {
 205                 Conf::set ("version", $ARGV[0]);
 206         }
 207         if ($opt_verbose) {
 208                 Base::setVerbose (1);
 209         }
 210         if ($opt_debug) {
 211                 Base::setDebug (1);
 212         }
 213         if ($opt_quiet) {
 214                 Base::setQuiet (1);
 215         }
 216
 217         # avoid silly messages with an early test
 218         my $v = Conf::get("version");
 219         my $mdir = Conf::get("libModules") . "/$v";
 220         if (! -d $mdir) {
 221                 Base::fatal ("unknown kernel version: $v");
 222         }
 223
 224         # go for it.
 225         if (defined ($opt_test)) {
 226                 TestSet::testAll();
 227         }
 228         elsif (defined ($opt_output)) {
 229                 go ($opt_format, $opt_output, $opt_root);
 230         }
 231         Base::bye;
 232 }
 233
 234 main ();