home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / TestBuild.pm < prev    next >
Encoding:
Perl POD Document  |  2002-05-22  |  14.5 KB  |  685 lines
  1. package Apache::TestBuild;
  2.  
  3. use strict;
  4. use warnings FATAL => 'all';
  5.  
  6. use subs qw(system chdir
  7.             info warning);
  8.  
  9. use Config;
  10. use File::Spec::Functions;
  11. use File::Path ();
  12. use Cwd ();
  13.  
  14. use constant DRYRUN => 0;
  15.  
  16. my @min_modules = qw(access auth log-config env mime setenvif
  17.                      mime autoindex dir alias);
  18.  
  19. my %shared_modules = (
  20.     min  => join(' ', @min_modules),
  21. );
  22.  
  23. my %configs = (
  24.     all => {
  25.         'apache-1.3' => [],
  26.         'httpd-2.0' => enable20(qw(modules=all proxy)),
  27.     },
  28.     most => {
  29.         'apache-1.3' => [],
  30.         'httpd-2.0' => enable20(qw(modules=most)),
  31.     },
  32.     min => {
  33.         'apache-1.3' => [],
  34.         'httpd-2.0' => enable20(@min_modules),
  35.     },
  36.     exp => {
  37.         'apache-1.3' => [],
  38.         'httpd-2.0' => enable20(qw(example case_filter
  39.                                    case_filter_in cache
  40.                                    echo deflate bucketeer)),
  41.     },
  42. );
  43.  
  44. my %builds = (
  45.      default => {
  46.          cflags => '-Wall',
  47.          config => {
  48.              'apache-1.3' => [],
  49.              'httpd-2.0'  => [],
  50.          },
  51.      },
  52.      debug => {
  53.          cflags => '-g',
  54.          config => {
  55.              'apache-1.3' => [],
  56.              'httpd-2.0'  => [qw(--enable-maintainer-mode)],
  57.          },
  58.      },
  59.      prof => {
  60.          cflags => '-pg -DGPROF',
  61.      },
  62.      shared => {
  63.          config =>  {
  64.              'apache-1.3' => [],
  65.              'httpd-2.0'  => enable20_shared('all'),
  66.          },
  67.      },
  68.      mostshared => {
  69.          config =>  {
  70.              'apache-1.3' => [],
  71.              'httpd-2.0'  => enable20_shared('most'),
  72.          },
  73.      },
  74.      minshared => {
  75.          config =>  {
  76.              'apache-1.3' => [],
  77.              'httpd-2.0'  => enable20_shared('min'),
  78.          },
  79.      },
  80.      static => {
  81.      },
  82. );
  83.  
  84. my %mpms = (
  85.     default => [qw(prefork worker)],
  86.     MSWin32 => [qw(winnt)],
  87. );
  88.  
  89. my @cvs = qw(httpd-2.0 apache-1.3);
  90.  
  91. my @dirs = qw(build tar src install);
  92.  
  93. sub enable20 {
  94.     [ map { "--enable-$_" } @_ ];
  95. }
  96.  
  97. sub enable20_shared {
  98.     my $name = shift;
  99.     my $modules = $shared_modules{$name} || $name;
  100.     enable20(qq(mods-shared="$modules"));
  101. }
  102.  
  103. sub default_mpms {
  104.     $mpms{ $^O } || $mpms{'default'};
  105. }
  106.  
  107. sub default_dir {
  108.     my($self, $dir) = @_;
  109.     $self->{$dir} ||= catdir $self->{prefix}, $dir,
  110. }
  111.  
  112. sub new {
  113.     my $class = shift;
  114.  
  115.     #XXX: not generating a BUILD script yet
  116.     #this way we can run:
  117.     #perl Apache-Test/lib/Apache/TestBuild.pm --cvsroot=anon --foo=...
  118.  
  119.     require Apache::TestConfig;
  120.     require Apache::TestTrace;
  121.     Apache::TestTrace->import;
  122.  
  123.     my $self = bless {
  124.         prefix => '/usr/local/apache',
  125.         cwd => Cwd::cwd(),
  126.         cvsroot => 'cvs.apache.org:/home/cvs',
  127.         cvs => \@cvs,
  128.         cvstag => "",
  129.         ssldir => "",
  130.         mpms => default_mpms(),
  131.         make => $Config{make},
  132.         builds => {},
  133.         name => "",
  134.         extra_config => {
  135.             'httpd-2.0' => [],
  136.         },
  137.         @_,
  138.     }, $class;
  139.  
  140.     #XXX
  141.     if (my $c = $self->{extra_config}->{'2.0'}) {
  142.         $self->{extra_config}->{'httpd-2.0'} = $c;
  143.     }
  144.  
  145.     for my $dir (@dirs) {
  146.         $self->default_dir($dir);
  147.     }
  148.  
  149.     if ($self->{ssldir}) {
  150.         push @{ $self->{extra_config}->{'httpd-2.0'} },
  151.           '--enable-ssl', "--with-ssl=$self->{ssldir}";
  152.     }
  153.  
  154.     $self;
  155. }
  156.  
  157. sub init {
  158.     my $self = shift;
  159.  
  160.     for my $dir (@dirs) {
  161.         mkpath($self->{$dir});
  162.     }
  163. }
  164.  
  165. use subs qw(symlink unlink);
  166. use File::Basename;
  167. use File::Find;
  168.  
  169. sub symlink_tree {
  170.     my $self = shift;
  171.  
  172.     my $httpd = 'httpd';
  173.     my $install = "$self->{install}/bin/$httpd";
  174.     my $source  = "$self->{build}/.libs/$httpd";
  175.  
  176.     unlink $install;
  177.     symlink $source, $install;
  178.  
  179.     my %dir = (apr => 'apr',
  180.                aprutil => 'apr-util');
  181.  
  182.     for my $libname (qw(apr aprutil)) {
  183.         my $lib = "lib$libname.so.0.0.0";
  184.         my $install = "$self->{install}/lib/$lib";
  185.         my $source  = "$self->{build}/srclib/$dir{$libname}/.libs/$lib";
  186.  
  187.         unlink $install;
  188.         symlink $source, $install;
  189.     }
  190.  
  191.     $install = "$self->{install}/modules";
  192.     $source  = "$self->{build}/modules";
  193.  
  194.     for (<$install/*.so>) {
  195.         unlink $_;
  196.     }
  197.  
  198.     finddepth(sub {
  199.         return unless /\.so$/;
  200.         my $file = "$File::Find::dir/$_";
  201.         symlink $file, "$install/$_";
  202.     }, $source);
  203. }
  204.  
  205. sub unlink {
  206.     my $file = shift;
  207.  
  208.     if (-e $file) {
  209.         print "unlink $file\n";
  210.     }
  211.     else {
  212.         print "$file does not exist\n";
  213.     }
  214.     CORE::unlink($file);
  215. }
  216.  
  217. sub symlink {
  218.     my($from, $to) = @_;
  219.     print "symlink $from => $to\n";
  220.     unless (-e $from) {
  221.         print "source $from does not exist\n";
  222.     }
  223.     my $base = dirname $to;
  224.     unless (-e $base) {
  225.         print "target dir $base does not exist\n";
  226.     }
  227.     CORE::symlink($from, $to) or die $!;
  228. }
  229.  
  230. sub cvs {
  231.     my $self = shift;
  232.  
  233.     my $cmd = "cvs -d $self->{cvsroot} @_";
  234.  
  235.     if (DRYRUN) {
  236.         info "$cmd";
  237.     }
  238.     else {
  239.         system $cmd;
  240.     }
  241. }
  242.  
  243. my %cvs_names = (
  244.     '2.0' => 'httpd-2.0',
  245.     '1.3' => 'apache-1.3',
  246. );
  247.  
  248. my %cvs_snames = (
  249.     '2.0' => 'httpd',
  250.     '1.3' => 'apache',
  251. );
  252.  
  253. sub cvs_up {
  254.     my($self, $version) = @_;
  255.  
  256.     my $name = $cvs_names{$version};
  257.  
  258.     my $dir = $self->srcdir($version);
  259.  
  260.     if ($self->{cvsroot} eq 'anon') {
  261.         $self->{cvsroot} = ':pserver:anoncvs@cvs.apache.org:/home/cvspublic';
  262.         unless (-d $dir) {
  263.             #XXX do something better than doesn't require prompt if
  264.             #we already have an entry in ~/.cvspass
  265.             #$self->cvs('login');
  266.  
  267.             warning "may need to run the following command ",
  268.                     "(password is 'anoncvs')";
  269.             warning "cvs -d $self->{cvsroot} login";
  270.         }
  271.     }
  272.  
  273.     if (-d $dir) {
  274.         chdir $dir;
  275.         $self->cvs(up => "-dP $self->{cvstag}");
  276.         return;
  277.     }
  278.  
  279.     my $co = checkout($name);
  280.     $self->$co($name, $dir);
  281.  
  282.     my $post = post_checkout($name);
  283.     $self->$post($name, $dir);
  284. }
  285.  
  286. sub checkout_httpd_2_0 {
  287.     my($self, $name, $dir) = @_;
  288.  
  289.     my $tag = $self->{cvstag};
  290.  
  291.     $self->cvs(co => "-d $dir $tag $name");
  292.     chdir "$dir/srclib";
  293.     $self->cvs(co => "$tag apr apr-util");
  294. }
  295.  
  296. sub checkout_apache_1_3 {
  297.     my($self, $name, $dir) = @_;
  298.  
  299.     $self->cvs(co => "-d $dir $self->{cvstag} $name");
  300. }
  301.  
  302. sub post_checkout_httpd_2_0 {
  303.     my($self, $name, $dir) = @_;
  304. }
  305.  
  306. sub post_checkout_apache_1_3 {
  307. }
  308.  
  309. sub canon {
  310.     my $name = shift;
  311.     return $name unless $name;
  312.     $name =~ s/[.-]/_/g;
  313.     $name;
  314. }
  315.  
  316. sub checkout {
  317.     my $name = canon(shift);
  318.     \&{"checkout_$name"};
  319. }
  320.  
  321. sub post_checkout {
  322.     my $name = canon(shift);
  323.     \&{"post_checkout_$name"};
  324. }
  325.  
  326. sub cvs_update {
  327.     my $self = shift;
  328.  
  329.     my $cvs = shift || $self->{cvs};
  330.  
  331.     chdir $self->{src};
  332.  
  333.     for my $name (@$cvs) {
  334.         $self->cvs_up($name);
  335.     }
  336. }
  337.  
  338. sub merge_build {
  339.     my($self, $version, $builds, $configs) = @_;
  340.  
  341.     my $b = {
  342.         cflags => $builds{default}->{cflags},
  343.         config => [ @{ $builds{default}->{config}->{$version} } ],
  344.     };
  345.  
  346.     for my $name (@$builds) {
  347.         next if $name eq 'default'; #already have this
  348.  
  349.         if (my $flags = $builds{$name}->{cflags}) {
  350.             $b->{cflags} .= " $flags";
  351.         }
  352.         if (my $cfg = $builds{$name}->{config}) {
  353.             if (my $vcfg = $cfg->{$version}) {
  354.                 push @{ $b->{config} }, @$vcfg;
  355.             }
  356.         }
  357.     }
  358.  
  359.     for my $name (@$configs) {
  360.         my $cfg = $configs{$name}->{$version};
  361.         next unless $cfg;
  362.         push @{ $b->{config} }, @$cfg;
  363.     }
  364.  
  365.     if (my $ex = $self->{extra_config}->{$version}) {
  366.         push @{ $b->{config} }, @$ex;
  367.     }
  368.  
  369.     if (my $ex = $self->{extra_cflags}->{$version}) {
  370.         $b->{config} .= " $ex";
  371.     }
  372.  
  373.     $b;
  374. }
  375.  
  376. my @srclib_dirs = qw(
  377.     apr apr-util apr-util/xml/expat pcre
  378. );
  379.  
  380. sub install_name {
  381.     my($self, $builds, $configs, $mpm) = @_;
  382.  
  383.     return $self->{name} if $self->{name};
  384.  
  385.     my $name = join '-', $mpm, @$builds, @$configs;
  386.  
  387.     if (my $tag = $self->cvs_name) {
  388.         $name .= "-$tag";
  389.     }
  390.  
  391.     $name;
  392. }
  393.  
  394. #currently the httpd-2.0 build does not properly support static linking
  395. #of ssl libs, force the issue
  396. sub add_ssl_libs {
  397.     my $self = shift;
  398.  
  399.     my $ssldir = $self->{ssldir};
  400.  
  401.     return unless $ssldir and -d $ssldir;
  402.  
  403.     my $name = $self->{current_install_name};
  404.  
  405.     my $ssl_mod = "$name/modules/ssl";
  406.     info "editing $ssl_mod/modules.mk";
  407.  
  408.     if (DRYRUN) {
  409.         return;
  410.     }
  411.  
  412.     my $ssl_mk = "$self->{build}/$ssl_mod/modules.mk";
  413.  
  414.     open my $fh, $ssl_mk or die "open $ssl_mk: $!";
  415.     my @lines = <$fh>;
  416.     close $fh;
  417.  
  418.     for (@lines) {
  419.         next unless /SH_LINK/;
  420.         chomp;
  421.         $_ .= " -L$ssldir -lssl -lcrypto\n";
  422.         info 'added ssl libs';
  423.         last;
  424.     }
  425.  
  426.     open $fh, '>', $ssl_mk or die $!;
  427.     print $fh join "\n", @lines;
  428.     close $fh;
  429. }
  430.  
  431. sub cvs_name {
  432.     my $self = shift;
  433.  
  434.     if (my $tag = $self->{cvstag}) {
  435.         $tag =~ s/^-[DAr]//;
  436.         $tag =~ s/\"//g;
  437.         $tag =~ s,[/ :],_,g; #-D"03/29/02 07:00pm"
  438.         return $tag;
  439.     }
  440.  
  441.     return "";
  442. }
  443.  
  444. sub srcdir {
  445.     my($self, $src) = @_;
  446.  
  447.     my $prefix = "";
  448.     if ($src =~ s/^(apache|httpd)-//) {
  449.         $prefix = $1;
  450.     }
  451.     else {
  452.         $prefix = $cvs_snames{$src};
  453.     }
  454.  
  455.     if ($src =~ /^\d\.\d$/) {
  456.         #release version will be \d\.\d\.\d+
  457.         if (my $tag = $self->cvs_name) {
  458.             $src .= "-$tag";
  459.         }
  460.         $src .= '-cvs';
  461.     }
  462.  
  463.     join '-', $prefix, $src;
  464. }
  465.  
  466. sub configure_httpd_2_0 {
  467.     my($self, $src, $builds, $configs, $mpm) = @_;
  468.  
  469.     $src = $self->srcdir($src);
  470.  
  471.     chdir $self->{build};
  472.  
  473.     my $name = $self->install_name($builds, $configs, $mpm);
  474.  
  475.     $self->{current_install_name} = $name;
  476.  
  477.     $self->{builds}->{$name} = 1;
  478.  
  479.     if ($self->{fresh}) {
  480.         rmtree($name);
  481.     }
  482.     else {
  483.         if (-e "$name/.DONE") {
  484.             warning "$name already configured";
  485.             warning "rm $name/.DONE to force";
  486.             return;
  487.         }
  488.     }
  489.  
  490.     my $build = $self->merge_build('httpd-2.0', $builds, $configs);
  491.  
  492.     $ENV{CFLAGS} = $build->{cflags};
  493.     info "CFLAGS=$ENV{CFLAGS}";
  494.  
  495.     my $prefix = "$self->{install}/$name";
  496.  
  497.     rmtree($prefix) if $self->{fresh};
  498.  
  499.     my $source = "$self->{src}/$src";
  500.  
  501.     my @args = ("--prefix=$prefix",
  502.                 "--with-mpm=$mpm",
  503.                 "--srcdir=$source",
  504.                 @{ $build->{config} });
  505.  
  506.     chdir $source;
  507.     system "./buildconf";
  508.  
  509.     my $cmd = "$source/configure @args";
  510.  
  511.     chdir $self->{build};
  512.  
  513.     mkpath($name);
  514.     chdir $name;
  515.  
  516.     for my $dir (@srclib_dirs) {
  517.         mkpath("srclib/$dir");
  518.     }
  519.  
  520.     for my $dir (qw(build docs/conf)) {
  521.         mkpath($dir);
  522.     }
  523.  
  524.     system $cmd;
  525.  
  526.     open FH, ">.DONE" or die "open .DONE: $!";
  527.     print FH scalar localtime;
  528.     close FH;
  529.  
  530.     chdir $self->{prefix};
  531.  
  532.     $self->add_ssl_libs;
  533. }
  534.  
  535. sub make {
  536.     my($self, @cmds) = @_;
  537.  
  538.     push @cmds, 'all' unless @cmds;
  539.  
  540.     for my $name (keys %{ $self->{builds} }) {
  541.         chdir "$self->{build}/$name";
  542.         for my $cmd (@cmds) {
  543.             system "$self->{make} $cmd";
  544.         }
  545.     }
  546. }
  547.  
  548. sub system {
  549.     my $cmd = "@_";
  550.  
  551.     info $cmd;
  552.     return if DRYRUN;
  553.  
  554.     unless (CORE::system($cmd) == 0) {
  555.         my $status = $? >> 8;
  556.         die "system $cmd failed (exit status=$status)";
  557.     }
  558. }
  559.  
  560. sub chdir {
  561.     my $dir = shift;
  562.     info "chdir $dir";
  563.     CORE::chdir $dir;
  564. }
  565.  
  566. sub mkpath {
  567.     my $dir = shift;
  568.  
  569.     return if -d $dir;
  570.     info "mkpath $dir";
  571.  
  572.     return if DRYRUN;
  573.     File::Path::mkpath([$dir], 1, 0755);
  574. }
  575.  
  576. sub rmtree {
  577.     my $dir = shift;
  578.  
  579.     return unless -d $dir;
  580.     info "rmtree $dir";
  581.  
  582.     return if DRYRUN;
  583.     File::Path::rmtree([$dir], 1, 1);
  584. }
  585.  
  586. sub generate_script {
  587.     my($class, $file) = @_;
  588.  
  589.     $file ||= catfile 't', 'BUILD';
  590.  
  591.     my $content = join '', <DATA>;
  592.  
  593.     Apache::Test::config()->write_perlscript($file, $content);
  594. }
  595.  
  596. unless (caller) {
  597.     $INC{'Apache/TestBuild.pm'} = __FILE__;
  598.     eval join '', <DATA>;
  599.     die $@ if $@;
  600. }
  601.  
  602. 1;
  603. __DATA__
  604. use strict;
  605. use warnings FATAL => 'all';
  606.  
  607. use lib qw(Apache-Test/lib);
  608. use Apache::TestBuild ();
  609. use Getopt::Long qw(GetOptions);
  610. use Cwd ();
  611.  
  612. my %options = (
  613.     prefix  => "checkout/build/install prefix",
  614.     ssldir  => "enable ssl with given directory",
  615.     cvstag  => "checkout with given cvs tag",
  616.     cvsroot => "use 'anon' for anonymous cvs",
  617.     version => "apache version (e.g. '2.0')",
  618.     mpms    => "MPMs to build (e.g. 'prefork')",
  619.     flavor  => "build flavor (e.g. 'debug shared')",
  620.     modules => "enable modules (e.g. 'all exp')",
  621.     name    => "change name of the build/install directory",
  622. );
  623.  
  624. my %opts;
  625.  
  626. Getopt::Long::Configure(qw(pass_through));
  627. #XXX: could be smarter here, being lazy for the moment
  628. GetOptions(\%opts, map "$_=s", sort keys %options);
  629.  
  630. if (@ARGV) {
  631.     print "passing extra args to configure: @ARGV\n";
  632. }
  633.  
  634. my $home = $ENV{HOME};
  635.  
  636. $opts{prefix}  ||= join '/', Cwd::cwd(), 'farm';
  637. #$opts{ssldir}  ||= '';
  638. #$opts{cvstag}  ||= '';
  639. #$opts{cvsroot} ||= '';
  640. $opts{version} ||= '2.0';
  641. $opts{mpms}    ||= 'prefork';
  642. $opts{flavor}  ||= 'debug-shared';
  643. $opts{modules} ||= 'all-exp';
  644.  
  645. #my @versions = qw(2.0);
  646.  
  647. #my @mpms = qw(prefork worker perchild);
  648.  
  649. #my @flavors  = ([qw(debug shared)], [qw(prof shared)],
  650. #                [qw(debug static)], [qw(prof static)]);
  651.  
  652. #my @modules = ([qw(all exp)]);
  653.  
  654. my $split = sub { split '-', delete $opts{ $_[0] } };
  655.  
  656. my @versions = $opts{version};
  657.  
  658. my @mpms = $split->('mpms');
  659.  
  660. my @flavors  = ([ $split->('flavor') ]);
  661.  
  662. my @modules  = ([ $split->('modules') ]);
  663.  
  664. my $tb = Apache::TestBuild->new(fresh => 1,
  665.                                 %opts,
  666.                                 extra_config => {
  667.                                     $opts{version} => \@ARGV,
  668.                                 });
  669.  
  670. $tb->init;
  671.  
  672. for my $version (@versions) {
  673.     $tb->cvs_update([ $version ]);
  674.  
  675.     for my $mpm (@mpms) {
  676.         for my $flavor (@flavors) {
  677.             for my $mods (@modules) {
  678.                 $tb->configure_httpd_2_0($version, $flavor,
  679.                                          $mods, $mpm);
  680.                 $tb->make(qw(all install));
  681.             }
  682.         }
  683.     }
  684. }
  685.