xpinstall/packager/Packager.pm

   1 #!perl -w
   2 package Packager;
   3
   4 require 5.004;
   5
   6 use strict;
   7 use File::stat;
   8 use Cwd;
   9 use File::Basename;
  10 use File::Copy;
  11 use File::Find;
  12 use File::Path;
  13 use File::stat;
  14 require Exporter;
  15
  16 use vars qw(@ISA @EXPORT);
  17
  18 # Package that generates a jar manifest from an input file
  19
  20 @ISA      = qw(Exporter);
  21 @EXPORT   = qw(
  22                 Copy
  23               );
  24
  25 # initialize variables
  26 my($saved_cwd)        = cwd();
  27 my($component)        = "";   # current component being copied
  28 my(@components)       = ();   # list of components to copy
  29 my($components)       = "";   # string version of @components
  30 my($altdest)          = "";   # alternate file destination
  31 my($line)             = "";   # line being processed
  32 my($srcdir)           = "";   # root directory being copied from
  33 my($destdir)          = "";   # root directory being copied to
  34 my($package)          = "";   # file listing files to copy
  35 my($os)               = "";   # os type (MSDOS, Unix)
  36 my($lineno)           = 0;    # line # of package file for error text
  37 my($debug)            = 0;    # controls amount of debug output
  38 my($dirflag)          = 0;    # flag: are we copying a directory?
  39 my($help)             = 0;    # flag: if set, print usage
  40 my($flat)             = 0;    # copy everything into the package dir, not into separate
  41                               #   component dirs
  42
  43 #
  44 # Copy
  45 #
  46 # Loop over each line in the specified manifest, copying into $destdir
  47 #
  48
  49 sub Copy {
  50   ($srcdir, $destdir, $package, $os, $flat, $help, $debug, @components) = @_;
  51
  52   check_arguments();
  53
  54   if ($os eq "MSDOS") {
  55     $srcdir =~ s|\\|/|;
  56     $destdir =~ s|\\|/|;
  57   }
  58
  59   open (MANIFEST,"<$package") ||
  60     die "Error: couldn't open file $package for reading: $!.  Exiting...\n";
  61
  62   LINE: while (<MANIFEST>) {
  63     $line =    "";
  64     $altdest = "";
  65     $lineno++;
  66
  67     s/\\/\//g if ($os eq "MSDOS");  # Convert to posix path
  68     s/\;.*//;     # it's a comment, kill it.
  69     s/^\s+//;     # nuke leading whitespace
  70     s/\s+$//;     # nuke trailing whitespace
  71
  72     ($debug >= 2) && print "\n";
  73     ($debug >= 8) && print "line $lineno:$_\n";
  74
  75     # it's a blank line, skip it.
  76     /^$/  && do {
  77         ($debug >= 10) && print "blank line.\n";
  78         next LINE;
  79     };
  80
  81     # it's a new component
  82     /^\[/ && do {
  83         ($debug >= 10) && print "component.\n";
  84         $component = $_;
  85         do_component();
  86         next LINE;
  87     };
  88
  89     # if we find a file before we have a component and we are in flat mode,
  90     # copy it - allows for flat only files (installed-chrome.txt)
  91     if (( $component eq "" ) && ($components eq "" ) && (!$flat)) {
  92       next LINE;
  93     }
  94
  95     # skip line if we're only copying specific components and outside
  96     # those components
  97     if (( $component eq "" ) && ($components ne "" )) {
  98       ($debug >= 10) && print "Not in specifed component.  Skipping $_\n";
  99       next LINE;
 100     }
 101     if ($line eq "") {
 102       $line = $_;       # if $line not set, set it.
 103     }
 104
 105     if ($os ne "MSDOS") {   # hack - need to fix for dos
 106       $line =~ s|^/||;    # strip any leading path delimiter
 107     }
 108
 109     # delete the file or directory following the '-'
 110     /^-/  && do {
 111         $line =~ s/^-//;    # strip leading '-'
 112         ($debug >= 10) && print "delete: $destdir/$component/$line\n";
 113         do_delete ("$destdir", "$component", "$line");
 114         next LINE;
 115     };
 116
 117     # file/directory being copied to different target location
 118     /\,/  && do {
 119         /.*\,.*\,.*/ &&
 120           die "Error: multiple commas not allowed ($package, $lineno): $_.\n";
 121         ($line, $altdest) = split (/\s*\,\s*/, $line, 2);
 122         $line =~ s|/*$||;    # strip any trailing path delimiters
 123         $altdest =~ s|/*$||; # strip any trailing delimiter
 124         ($debug >= 10) && print "relocate: $line => $altdest.\n";
 125     };
 126
 127     # if it has wildcards, do recursive copy.
 128     /(?:\*|\?)/ && do {
 129       ($debug >= 10) && print "wildcard copy.\n";
 130       do_wildcard ("$srcdir/$line");
 131       next LINE;
 132     };
 133
 134     # if it's a single file, copy it.
 135     ( -f "$srcdir/$line" ) && do {
 136       ($debug >= 10) && print "file copy.\n";
 137       do_copyfile ();
 138       next LINE;
 139     };
 140
 141     # if it's a directory, do recursive copy.
 142     (-d "$srcdir/$line") && do {
 143       ($debug >= 10) && print "directory copy.\n";
 144       do_copydir ("$srcdir/$line");
 145       next LINE;
 146     };
 147
 148     # if we hit this, it's either a file in the package file that is
 149     # not in the src directory, or it is not a valid entry.
 150     print "Warning: package error or possible missing or unnecessary file: $line ($package, $lineno).\n";
 151
 152   } # LINE
 153
 154   close (MANIFEST);
 155   chdir ($saved_cwd);
 156
 157 }
 158
 159 #
 160 # Delete the given file or directory
 161 #
 162 sub do_delete
 163 {
 164   my ($targetpath) = $_[0];
 165   my ($targetcomp) = $_[1];
 166   my ($targetfile) = $_[2];
 167   my ($target) = ($flat) ? "$targetpath/$targetfile" : "$targetpath/$targetcomp/$targetfile";
 168
 169   ($debug >= 2) && print "do_delete():\n";
 170   ($debug >= 1) && print "-$targetfile\n";
 171
 172   if ( -f $target ) {
 173     (! -w $target ) &&
 174       die "Error: delete failed: $target not writeable ($package, $component, $lineno).  Exiting...\n";
 175     ($debug >= 4) && print " unlink($target)\n";
 176     unlink ($target) ||
 177       die "Error: unlink() failed: $!.  Exiting...\n";
 178   } elsif ( -d $target ) {
 179     (! -w $target ) &&
 180       die "Error: delete failed: $target not writeable ($package, $component, $lineno).  Exiting...\n";
 181     ($debug >= 4) && print " rmtree($target)\n";
 182     rmtree ($target, 0, 0) ||
 183       die "Error: rmtree() failed: $!.  Exiting...\n";
 184   } else {
 185     warn "Warning: delete failed: $target is not a file or directory ($package, $component, $lineno).\n";
 186   }
 187 }
 188
 189
 190 #
 191 # Copy an individual file from the srcdir to the destdir.
 192 #
 193 # This is called by both the individual and batch/recursive copy routines,
 194 # using $dirflag to check if called from do_copydir.  Batch copy can pass in
 195 # directories, so be sure to check first and break if it isn't a file.
 196 #
 197 sub do_copyfile
 198 {
 199   my ($destpath)     = "";  # destination directory path
 200   my ($destpathcomp) = "";  # ditto, but possibly including component dir
 201   my ($destname)     = "";  # destination file name
 202   my ($destsuffix)   = "";  # destination file name suffix
 203   my ($altpath)      = "";  # alternate destination directory path
 204   my ($altname)      = "";  # alternate destination file name
 205   my ($altsuffix)    = "";  # alternate destination file name suffix
 206   my ($srcpath)      = "";  # source file directory path
 207   my ($srcname)      = "";  # source file name
 208   my ($srcsuffix)    = "";  # source file name suffix
 209
 210   ($debug >= 2) && print "do_copyfile():\n";
 211
 212   # set srcname correctly depending on how called
 213   if ( $dirflag ) {
 214     ($srcname, $srcpath, $srcsuffix) = fileparse("$File::Find::name", '\..*?$');
 215   } else {
 216     ($srcname, $srcpath, $srcsuffix) = fileparse("$srcdir/$line", '\..*?$');
 217   }
 218
 219   ($debug >= 4) && print " fileparse(src): $srcpath $srcname $srcsuffix\n";
 220
 221   # return if srcname is a directory from do_copydir
 222   if ( -d "$srcpath$srcname$srcsuffix" ) {
 223     ($debug >= 10) && print " return: $srcpath$srcname$srcsuffix is a directory\n";
 224     return;
 225   }
 226
 227   # set the destination path, if alternate destination given, use it.
 228   if ($flat) {
 229     if ($srcsuffix eq ".xpt" && $srcpath =~ m|bin/components/$|) {
 230       if ($component eq "") {
 231         die ("XPT file was not part of a component.");
 232       }
 233
 234       $destpathcomp = "$srcdir/xpt/$component";
 235     }
 236     else {
 237       $destpathcomp = "$destdir";
 238     }
 239   } else {
 240     if ( $component ne "" ) {
 241       $destpathcomp = "$destdir/$component";
 242     }
 243     else {
 244       $destpathcomp = "$destdir";
 245     }
 246   }
 247   if ( $altdest ne "" ) {
 248     if ( $dirflag ) { # directory copy to altdest
 249       ($destname, $destpath, $destsuffix) = fileparse("$destpathcomp/$altdest/$File::Find::name", '\..*?$');
 250       # Todo: add MSDOS hack
 251       $destpath =~ s|$srcdir/$line/||;  # rm info added by find
 252       ($debug >= 5) &&
 253         print " dir copy to altdest: $destpath $destname $destsuffix\n";
 254     } else {  # single file copy to altdest
 255       ($destname, $destpath, $destsuffix) = fileparse("$destpathcomp/$altdest", '\..*?$');
 256       ($debug >= 5) &&
 257         print " file copy to altdest: $destpath $destname $destsuffix\n";
 258     }
 259   } else {
 260     if ( $dirflag ) { # directory copy, no altdest
 261       my $destfile = $File::Find::name;
 262       if ($os eq "MSDOS") {
 263         $destfile =~ s|\\|/|;
 264       }
 265       $destfile =~ s|$srcdir/||;
 266
 267       ($destname, $destpath, $destsuffix) = fileparse("$destpathcomp/$destfile", '\..*?$');
 268
 269       ($debug >= 5) &&
 270         print " dir copy w/o altdest: $destpath $destname $destsuffix\n";
 271     } else {  # single file copy, no altdest
 272       ($destname, $destpath, $destsuffix) = fileparse("$destpathcomp/$line", '\..*?$');
 273       ($debug >= 5) &&
 274         print " file copy w/o altdest: $destpath $destname $destsuffix\n";
 275     }
 276   }
 277
 278   if ($flat) {
 279     $destpath =~ s|bin[/\\]||;
 280   }
 281
 282   # create the destination path if it doesn't exist
 283   if (! -d "$destpath" ) {
 284     ($debug >= 5) && print " mkpath($destpath)\n";
 285     # For OS/2 - remove trailing '/'
 286     chop($destpath);
 287     mkpath ($destpath, 0, 0755) ||
 288       die "Error: mkpath() failed: $!.  Exiting...\n";
 289     # Put delimiter back for copying...
 290     $destpath = "$destpath/";
 291   }
 292
 293   # path exists, source and destination known, time to copy
 294   if ((-f "$srcpath$srcname$srcsuffix") && (-r "$srcpath$srcname$srcsuffix")) {
 295     if ( $debug >= 1 ) {
 296       if ( $dirflag ) {
 297         print "$destname$destsuffix\n"; # from unglob
 298       } else {
 299         print "$line\n";    # from single file
 300       }
 301       if ( $debug >= 3 ) {
 302         print " copy\t$srcpath$srcname$srcsuffix =>\n\t\t$destpath$destname$destsuffix\n";
 303       }
 304     }
 305     unlink("$destpath$destname$destsuffix") if ( -e "$destpath$destname$destsuffix");
 306     copy ("$srcpath$srcname$srcsuffix", "$destpath$destname$destsuffix") ||
 307       die "Error: copy of file $srcpath$srcname$srcsuffix failed ($package, $component, $lineno): $!.  Exiting...\n";
 308
 309     # if this is unix, set the dest file permissions
 310     # read permissions
 311     my($st) = stat("$srcpath$srcname$srcsuffix") ||
 312         die "Error: can't stat $srcpath$srcname$srcsuffix: $!  Exiting...\n";
 313     # set permissions
 314     ($debug >= 2) && print " chmod ".$st->mode." $destpath$destname$destsuffix\n";
 315     chmod ($st->mode, "$destpath$destname$destsuffix") ||
 316         warn "Warning: chmod of $destpath$destname$destsuffix failed: $!.  Exiting...\n";
 317       } else {
 318     warn "Error: file $srcpath$srcname$srcsuffix is not a file or is not readable ($package, $component, $lineno).\n";
 319       }
 320 }
 321
 322
 323 #
 324 # Expand any wildcards and copy files and/or directories
 325 #
 326 # todo: pass individual files to do_copyfile, not do_copydir
 327 #
 328 sub do_wildcard
 329 {
 330   my ($entry) = $_[0];
 331   my (@list)  = ();
 332   my ($item)  = "";
 333
 334   ($debug >= 2) && print "do_wildcard():\n";
 335
 336   if ( $entry =~ /(?:\*|\?)/ ) {    # it's a wildcard,
 337     @list = glob($entry);     # expand it
 338     ($debug >= 4) && print " glob: $entry => @list\n";
 339
 340     foreach $item ( @list ) {     # now copy each item in list
 341       if ( -f $item ) {
 342         ($debug >= 10) && print " do_copyfile: $item\n";
 343
 344         # glob adds full path to item like find() in copydir so
 345         # take advantage of existing code in copyfile by using
 346         # $dirflag and $File::Find::name.
 347
 348         $File::Find::name = $item;
 349         $dirflag = 1;
 350         do_copyfile();
 351         $dirflag = 0;
 352         $File::Find::name = "";
 353       } elsif ( -d $item ) {
 354         ($debug >= 10) && print " do_copydir($item)\n";
 355         do_copydir ($item);
 356       } else {
 357         warn "Warning: $item is not a file or directory ($package, $component, $lineno).  Skipped...\n";
 358       }
 359     }
 360   }
 361 }
 362
 363 #
 364 # Recursively copy directories specified.
 365 #
 366 sub do_copydir
 367 {
 368   my ($entry) = $_[0];
 369
 370   $dirflag = 1;     # flag indicating directory copy in progress
 371
 372   ($debug >= 2) && print "do_copydir():\n";
 373
 374   if (! -d "$entry" ) {
 375     warn "Warning: $entry is not a directory ($package, $component, $lineno).  Skipped...\n";
 376   }
 377
 378   ($debug >= 4) && print " find($entry)\n";
 379
 380   find (\&do_copyfile, $entry);
 381
 382   $dirflag = 0;
 383 }
 384
 385
 386 #
 387 # Handle new component
 388 #
 389 sub do_component
 390 {
 391   ($debug >= 2) && print "do_component():\n";
 392
 393   ( $component =~ /^\[.*(?:\s|\[|\])+.*\]/ ) && # no brackets or ws
 394     die "Error: malformed component $component.  Exiting...\n";
 395   $component =~ s/^\[(.*)\]/$1/;  # strip []
 396
 397   if ( $components ne "") {
 398     if ( $components =~ /$component/ ) {
 399       ($debug >= 10) && print "Component $component is in $components.\n";
 400     } else {
 401       ($debug >= 10) && print "Component $component not in $components.\n";
 402       $component = "";
 403       return;   # named specific components and this isn't it
 404     }
 405   }
 406
 407   if ($debug >= 1) {
 408     print "[$component]\n";
 409   }
 410   # create component directory
 411   if (!$flat) {
 412     if ( -d "$destdir/$component" ) {
 413       warn "Warning: component directory \"$component\" already exists in \"$destdir\".\n";
 414     } else {
 415       ($debug >= 4) && print " mkdir $destdir/$component\n";
 416       mkdir ("$destdir/$component", 0755) ||
 417         die "Error: couldn't create component directory \"$component\": $!.  Exiting...\n";
 418     }
 419   }
 420 }
 421
 422
 423 #
 424 # Check that arguments to script are valid.
 425 #
 426 sub check_arguments
 427 {
 428   my ($exitval) = 0;
 429
 430   ($debug >= 2) && print "check_arguments():\n";
 431
 432   # if --help print usage
 433   if ($help) {
 434     print_usage();
 435     exit (1);
 436   }
 437
 438   # make sure required variables are set:
 439   # check source directory
 440   if ( $srcdir eq "" ) {
 441     print "Error: source directory (--source) not specified.\n";
 442     $exitval += 8;
 443   } elsif ((! -d $srcdir) || (! -r $srcdir)) {
 444     print "Error: source directory \"$srcdir\" is not a directory or is unreadable.\n";
 445     $exitval = 1;
 446   }
 447
 448   # check destination directory
 449   if ( $destdir eq "" ) {
 450     print "Error: destination directory (--destination) not specified.\n";
 451     $exitval += 8;
 452   } elsif ((! -d $destdir) || (! -w $destdir)) {
 453     print "Error: destination directory \"$destdir\" is not a directory or is not writeable.\n";
 454     $exitval += 2;
 455   }
 456
 457   # check destdir not a subdir of srcdir
 458   # hack - workaround for bug 14558 that should be fixed eventually.
 459   if (0) {  # todo - write test
 460     print "Error: destination directory must not be subdirectory of the source directory.\n";
 461     $exitval += 32;
 462   }
 463
 464   # check package file
 465   if ( $package eq "" ) {
 466     print "Error: package file (--file) not specified.\n";
 467     $exitval += 8;
 468   } elsif (!(-f $package) || !(-r $package)) {
 469     print "Error: package file \"$package\" is not a file or is unreadable.\n";
 470     $exitval += 4;
 471   }
 472
 473   # check OS == {unix|dos}
 474   if ($os eq "") {
 475     print "Error: OS type (--os) not specified.\n";
 476     $exitval += 8;
 477   } elsif ( $os =~ /dos/i ) {
 478     $os = "MSDOS";
 479     fileparse_set_fstype ($os);
 480   } elsif ( $os =~ /unix/i ) {
 481     $os = "Unix";       # can be anything but MSDOS
 482     fileparse_set_fstype ($os);
 483   } else {
 484     print "Error: OS type \"$os\" unknown.\n";
 485     $exitval += 16;
 486   }
 487
 488   # turn components array into a string for regexp
 489   if ( @components > 0 ) {
 490     $components = join (",",@components);
 491   } else {
 492     $components = "";
 493   }
 494
 495   if ($debug > 4) {
 496     print ("source dir:\t$srcdir\ndest dir:\t$destdir\npackage:\t$package\nOS:\t$os\ncomponents:\t$components\n");
 497   }
 498
 499   if ($exitval) {
 500     print "See \'$0 --help\' for more information.\n";
 501     print "Exiting...\n";
 502     exit ($exitval);
 503   }
 504
 505 }
 506
 507
 508
 509 #
 510 # display usage information
 511 #
 512 sub print_usage
 513 {
 514   ($debug >= 2) && print "print_usage():\n";
 515
 516   print <<EOC
 517
 518 $0
 519   Copy files from the source directory to component directories
 520   in the destination directory as specified by the package file.
 521
 522 Options:
 523   -s, --source <source directory>
 524     Specifies the directory from which to copy the files
 525     specified in the file passed via --file.
 526     Required.
 527
 528   -d, --destination <destination directory>
 529     Specifies the directory in which to create the component
 530     directories and copy the files specified in the file passed
 531     via --file.
 532     Required.
 533
 534 NOTE: Source and destination directories must be absolute paths.
 535   Relative paths will NOT work.  Also, the destination directory
 536   must NOT be a subdirectory of the source directory.
 537
 538   -f, --file <package file>
 539     Specifies the file listing the components to be created in
 540     the destination directory and the files to copy from the
 541     source directory to each component directory in the
 542     destination directory.
 543     Required.
 544
 545   -o, --os [dos|unix]
 546     Specifies which type of system this is.  Used for parsing
 547     file specifications from the package file.
 548     Required.
 549
 550   -c, --component <component name>
 551     Specifies a specific component in the package file to copy
 552     rather than copying all the components in the package file.
 553     Can be used more than once for multiple components (e.g.
 554     "-c browser -c mail" to copy mail and news only).
 555     Optional.
 556
 557   -l, --flat
 558                 Suppresses creation of components dirs, but stuffes everything
 559                 directly into the package destination dir. This is useful
 560                 for creating tarballs.
 561
 562   -h, --help
 563     Prints this information.
 564     Optional.
 565
 566   --debug [1-10]
 567     Controls verbosity of debugging output, 10 being most verbose.
 568       1 : same as --verbose.
 569       2 : includes function calls.
 570       3 : includes source and destination for each copy.
 571     Optional.
 572
 573   -v, --verbose
 574     Print component names and files copied/deleted.
 575     Optional.
 576
 577
 578 e.g.
 579
 580 $0 --os unix --source /builds/mozilla/dist --destination /h/lithium/install --file packages-win --os unix --verbose
 581
 582 Note: options can be specified by either a leading '--' or '-'.
 583
 584 EOC
 585 }