bfd

   1 #!/usr/bin/perl -w
   2 ###APPNAME:     bfd
   3 ###APPAUTHOR:   duel
   4 ###APPDATE:     2009-05-21 15:08:33
   5 ###APPVER:      0.1
   6 ###APPDESC:     floppy building system
   7 ###APPUSAGE:    [-w dir][-c file][-o os] [-d] [-i file] [-t type] name [target]
   8 ###APPOPTION:   name:name of the disk or image to build (see bfd.cfg)|target:target drive or file (default is "a:")|-o os:os to use (default is "md701")|-d:print debug messages|-i file:create an image file (optional winimage!)|-t type:image type (144 or 288,see "bfi")|-n:don't wait for the user to insert a diskette|-w dir:specify working directory|-c file:specify configure file(default bfd.cfg)
   9 use strict;
  10
  11 #ENV variable MUST be defined somewhere,
  12 #FOR perl to search modules from,
  13 #OR nothing will work
  14 use lib $ENV{XR_PERL_MODULE_DIR};
  15
  16 use MyPlace::Script::Usage qw/help_required help_even_empty/;
  17 #exit 0 if(help_required($0,@ARGV));
  18 exit 0 if(help_even_empty($0,@ARGV));
  19 my ($debug,$os,$filename,$type,$name,$target);
  20 my %o;my $op;
  21
  22 foreach(@ARGV) {
  23     if($_ eq '-d' or $_ eq '-d') {
  24         $o{-d}=1;
  25     }
  26     elsif(/^-/) {
  27         $op=lc($_);
  28     }
  29     elsif($op) {
  30         $o{$op}=$_;
  31         $op=undef;
  32     }
  33     else {
  34         if($o{name}) {
  35             $o{target}=$_;
  36         }
  37         else {
  38             $o{name}=$_;
  39         }
  40     }
  41 }
  42 #use Data::Dumper;warn Dumper(\%o),"\n";
  43
  44 sub maybe_uc($$) {
  45     my ($fst,$sec) = @_;
  46     return "$fst/" . uc($sec) if(-f "$fst/" . uc($sec));
  47
  48 }
  49
  50 sub msg {
  51     if(@_) {
  52         print STDERR "$0: ",@_;
  53     }
  54     else {
  55         print STDERR "\n";
  56     }
  57 }
  58 sub abort {
  59     msg @_;
  60     die();
  61 }
  62 sub cmd_abort {
  63     print STDERR "\t[" . "@_" ."]\n";
  64     return undef;
  65 }
  66 sub run {
  67     if($o{-d}) {
  68         msg("@_","\n");
  69         return 1;
  70     }
  71     if(system(@_)==0) {
  72         return 1;
  73     }
  74     else {
  75         msg("Invalid exit code while runing \"",join(" ",@_),"\"\n");
  76         return undef;
  77     }
  78     return 1;
  79 }
  80 sub t_run {
  81     if($o{-d}) {
  82         msg("@_","\n");
  83     }
  84     else {
  85         system(@_);
  86     }
  87     return 1;
  88 }
  89
  90 abort("Error, name required.\n") unless($o{name});
  91 abort("Error, filename required.(-i)\n") unless($o{-i});
  92
  93 my $bfd_src= $o{-w} ||  ".";
  94 my $bfd_config;
  95 $o{-c} = "bfd.cfg" unless($o{-c});
  96 foreach($o{-c}, "bfd.cfg","$bfd_src/$o{-c}","$bfd_src/bfd.cfg") {
  97     if(-f $_) {
  98         $bfd_config=$_;
  99         last;
 100     }
 101 }
 102 abort("Error, configure file not found\n") unless($bfd_config);
 103 my $bfd_work=$bfd_config;
 104 $bfd_work =~ s/\/[^\/]+$//;
 105 $bfd_work = "." unless(-d $bfd_work);
 106
 107 my %cached;
 108 sub read_cfg {
 109     my $fn=shift;
 110     return undef unless($fn);
 111     return $cached{$fn} if($cached{$fn});
 112 #    warn("reading $fn ...\n");
 113     open FI,"<",$fn or return undef; my @text=<FI>; close FI;
 114     my @result=();
 115     foreach(@text) {
 116         chomp;
 117         next if((!$_) or /^\s*$/ or /^\s*#/);
 118         s/\\/\//g;
 119         if(/^\s*i\s+/) {
 120             $_ =~ s/^\s*i\s+//;
 121             my @files = split(/\s+/,$_);
 122             foreach(@files) {
 123                 my $rr = &read_cfg($bfd_work . "/$_");
 124                 push @result,@{$rr} if($rr);
 125             }
 126         }
 127         else {
 128             push @result,$_;
 129         }
 130     }
 131     $cached{$fn} = [@result];
 132     return \@result;
 133 }
 134
 135 sub parse_cfg {
 136     my $text = shift;
 137     return undef unless($text);
 138     my %result; my $name = "default";
 139     foreach(@{$text}) {
 140         my @arg=split(/\s+/,$_);
 141         next unless(@arg);
 142         $arg[0] = lc($arg[0]);
 143         if($arg[0] eq 'n') {
 144             $name = $arg[1] if($arg[1]);
 145         }
 146         else {
 147             push @{$result{$name}},[@arg];
 148         }
 149     }
 150     return %result;
 151 }
 152 my $text = read_cfg($bfd_config);
 153 my %config = parse_cfg($text);
 154 abort("config name [" . $o{name} . "] not exist\n") unless($config{$o{name}});
 155 #print STDERR Dumper($config{$o{name}}),"\n";
 156 my @cmd = @{$config{$o{name}}};
 157
 158 use File::Temp qw/tempdir/;
 159 my $bfd_target = tempdir();
 160 my $bfd_os = $o{-o} || "md701";
 161 my $bfd_file = $o{-i};
 162 my $bfd_label = "boot";
 163 my $bfd_type = $o{-t} || "144";
 164 my @bfd_cmds;
 165
 166 foreach(@cmd) {
 167     next unless($_);
 168     my($name,@args) = @{$_};
 169     if($name eq "f") {
 170         next;
 171     }
 172     elsif($name eq "o" or $name eq "os") {
 173         next if($o{-o});
 174         $bfd_os = $args[0] if(@args);
 175     }
 176     elsif($name eq "b") {
 177         $bfd_label = $args[0] if(@args);
 178     }
 179     elsif($name eq "it") {
 180         $bfd_type = $args[0] if(@args);
 181     }
 182     else {
 183         push @bfd_cmds,[$name,@args];
 184     }
 185 }
 186 sub expand {
 187     my @result;
 188     foreach(@_) {
 189         s/%bfd_os%/$bfd_os/g;
 190         s/%bfd_file%/$bfd_file/g;
 191         s/%bfd_label%/$bfd_label/g;
 192         s/%bfd_target%/$bfd_target/g;
 193         s/%bfd_type%/$bfd_type/g;
 194         push @result,$_;
 195     }
 196     return @result;
 197 }
 198 ($bfd_label)=expand($bfd_label);
 199 ($bfd_file)=expand($bfd_file);
 200 @cmd=@bfd_cmds;
 201 @bfd_cmds=();
 202 foreach(@cmd) {
 203     push @bfd_cmds,[expand(@{$_})];
 204 }
 205
 206 sub cmd_c {
 207     return cmd_abort("Invalid command") unless(@_);
 208     my $dst="$bfd_target/" . ($_[1] ? $_[1] : "");
 209     run("cp","-fa",glob("$bfd_src/$_[0]"),$dst);
 210 }
 211 sub cmd_t {
 212     return cmd_abort("Invalid command") unless(@_);
 213     my $dst="$bfd_target/" . ($_[1] ? $_[1] : "");
 214     t_run("cp","-fa",glob("$bfd_src/$_[0]"),"$dst");
 215 }
 216 sub cmd_x {
 217     return cmd_abort("Invalid command") unless(@_);
 218     return cmd_abort("Directory not exist $_[0]") unless(-d "$bfd_src/$_[0]");
 219     my $dst="$bfd_target/" . ($_[1] ? $_[1] : "");
 220     my @src = glob("$bfd_src/$_[0]/*");
 221     run("cp","-fa",@src,$dst) if(@src);
 222     return 1;
 223 }
 224 sub cmd_m {
 225     return cmd_abort("Invalid command") unless(@_);
 226     run("mkdir","-p",map("$bfd_target/" . $_,@_));
 227 }
 228 sub cmd_d {
 229     return cmd_abort("Invalid command") unless($_[2]);
 230 }
 231
 232 sub cmd_k {
 233     return cmd_abort("Invalid command") unless(@_);
 234     run("rm","-f",map("$bfd_target/" . $_,@_));
 235 }
 236
 237 msg("Checking OS...\n");
 238 my @ofile;
 239 abort("OS directory not readable\n") unless(-d "$bfd_src/os/$bfd_os");
 240 if(-f "$bfd_src/os/$bfd_os/ibmbio.sys") {
 241     @ofile = qw/ibmbio.sys ibmdos.sys command.com/;
 242 }
 243 elsif(-f "$bfd_src/os/$bfd_os/kernel.sys") {
 244     @ofile = qw/kernel.sys command.com/;
 245 }
 246 else {
 247     @ofile = qw/io.sys msdos.sys command.com/;
 248 }
 249 my @tfile=@ofile;
 250 @ofile=();
 251 foreach(@tfile,"bootsect.bin") {
 252     if (-f "$bfd_src/os/$bfd_os/$_") {
 253         push @ofile,$_ unless($_ eq "bootsect.bin");
 254     }
 255     elsif(-f "$bfd_src/os/$bfd_os/" . uc($_)) {
 256         push @ofile,uc($_) unless($_ eq "bootsect.bin");
 257     }
 258     else {
 259         abort("OS file not exist \"$bfd_src/os/$bfd_os/$_\"\n");
 260     }
 261 }
 262
 263 msg("Processing commands...\n");
 264 foreach(@bfd_cmds) {
 265     next unless($_);
 266     my ($name,@args)=@{$_};
 267     msg($name," @args...");# if($o{-d});
 268     $name = "cmd_" . $name;
 269     no strict;# refs;
 270     if(&$name(@args)) {
 271         print STDERR "\t[OK]\n";
 272     }
 273     else {
 274         abort("Aborted...\n");
 275     }
 276 }
 277
 278 #my @bfi = ("bfi","-t",$bfd_type,"-l",$bfd_label,"-f",$bfd_file,-"b","$bfd_src/os/$bfd_os/bootsect.bin");
 279 my @bfi = ("bfi","-t",$bfd_type,"-f",$bfd_file,-"b","$bfd_src/os/$bfd_os/bootsect.bin");
 280 push(@bfi,"-o","$bfd_src/os/$bfd_os/$_") foreach(@ofile);
 281 @ofile=undef;
 282 #msg("OS   \t[$bfd_os]\n");
 283 #msg("File \t[$bfd_file]\n");
 284 #msg("Label\t[$bfd_label]\n");
 285 #msg("Type \t[$bfd_type]\n");
 286 #msg("BFI  \t[","@bfi","]\n");
 287 #system("ls","-l",$bfd_target);
 288 system(@bfi,$bfd_target);
 289 #system("rm","-fdr",$bfd_target);
 290
 291
 292
 293
 294