#!C:/Perl/bin ##################################################################### # A Perl script to fetch and install via ppm mod_perl on Win32 # Copyright 2002, by Randy Kobes. # This script may be distributed under the same terms as Perl itself. # Please report problems to Randy Kobes ##################################################################### use strict; use warnings; use ExtUtils::MakeMaker; use LWP::Simple; use File::Copy; use Config; use Safe; use Digest::MD5; require Win32; require File::Spec; die "This only works for Win32" unless $^O =~ /Win32/i; die "No mod_perl ppm package available for this Perl" if ($] < 5.006001); my ($apache2, $apache, $apache22); my @drives = drives(); # find a possible Apache2 directory APACHE2: { for my $drive (@drives) { for my $p ('Apache2', 'Program files/Apache2', 'Program Files/Apache Group/Apache2') { my $candidate = File::Spec->catpath($drive, $p); if (-d $candidate) { $apache2 = $candidate; last APACHE2; } } } } if ($apache2) { $apache2 = fix_path($apache2); my $ans = prompt(qq{Install mod_perl-2 for "$apache2"?}, 'yes'); $apache2 = undef unless ($ans =~ /^y/i); } # if no Apache2, try to find Apache1 unless ($apache2) { APACHE: { for my $drive (@drives) { for my $p ('Apache', 'Program Files/Apache', 'Program Files/Apache Group/Apache') { my $candidate = File::Spec->catpath($drive, $p); if (-d $candidate) { $apache = $candidate; last APACHE; } } } } } if ($apache) { $apache = fix_path($apache); my $ans = prompt(qq{Install mod_perl 1 for "$apache"?}, 'yes'); $apache = undef unless ($ans =~ /^y/i); } # check Apache versions if ($apache or $apache2) { my $vers; if ($apache) { $vers = qx{"$apache/apache.exe" -v}; die qq{"$apache" does not appear to be version 1.3} unless $vers =~ m!Apache/1.3!; } else { my $vers; for my $binary(qw(Apache.exe httpd.exe)) { my $b = File::Spec->catfile($apache2, 'bin', $binary); next unless -x $b; $vers = qx{$b -v}; last; } die qq{Cannot determine the Apache version} unless $vers; die qq{"$apache2" does not appear to be version 2.x} unless $vers =~ m!Apache/2.!; $apache22 = 1 if $vers =~ m!Apache/2.2!; } } # prompt to get an Apache installation directory else { my $dir = prompt("Where is your apache installation directory?", ''); die 'Need to specify the Apache installation directory' unless $dir; $dir = fix_path($dir); die qq{"$dir" does not exist} unless (-d $dir); if ($dir =~ /Apache2/) { my $ans = prompt(qq{Install mod_perl 2 for "$dir"?}, 'yes'); $apache2 = $dir if ($ans =~ /^y/i); } else { my $ans = prompt(qq{Install mod_perl 1 for "$dir"?}, 'yes'); $apache = $dir if ($ans =~ /^y/i); } unless ($apache or $apache2) { my $mpv = prompt('Which mod_perl version would you like [1 or 2]?', 2); if ($mpv == 1) { $apache = $dir; } elsif ($mpv == 2) { $apache2 = $dir; } else { die 'Please specify either "1" or "2"'; } } } die 'Please specify an Apache directory' unless ($apache or $apache2); my $theoryx5 = 'http://theoryx5.uwinnipeg.ca'; my $ppms = $theoryx5 . '/ppms/'; my $ppmsx86 = $ppms . 'x86/'; my $ppmpackages = $theoryx5 . '/ppmpackages/'; my $ppmpackagesx86 = $ppmpackages . 'x86/'; my ($ppd, $tgz, $ppdfile, $tgzfile, $checksums, $so_fetch, $so_fake); my $so = 'mod_perl.so'; my $cs = 'CHECKSUMS'; # set appropriate ppd and tar.gz files if ($] < 5.008) { $checksums = $ppmpackagesx86 . $cs; if ($apache2) { die 'No mod_perl 2 package available for this perl version'; } else { my $ans = prompt('Do you need EAPI support for mod_ssl?', 'no'); if ($ans =~ /^n/i) { $ppdfile = 'mod_perl.ppd'; $tgzfile = 'mod_perl.tar.gz'; $so_fake = 'mod_perl.so'; } else { $ppdfile = 'mod_perl-eapi.ppd'; $tgzfile = 'mod_perl-eapi.tar.gz'; $so_fake = 'mod_perl-eapi.so'; } $ppd = $ppmpackages . $ppdfile; $tgz = $ppmpackagesx86 . $tgzfile; $so_fetch = $ppmpackagesx86 . $so_fake; } } else { $checksums = $ppmsx86 . $cs; if ($apache2) { my $ans = prompt('Do you want the latest mod_perl 2 development version?', 'no'); if ($ans =~ /^n/i) { if ($apache22) { $ppdfile = 'mod_perl.ppd'; $tgzfile = 'mod_perl.tar.gz'; $so_fake = 'mod_perl.so'; } else { $ppdfile = 'mod_perl-2.0.ppd'; $tgzfile = 'mod_perl-2.0.tar.gz'; $so_fake = 'mod_perl-2.0.so'; } } else { $ppdfile = 'mod_perl-dev.ppd'; $tgzfile = 'mod_perl-dev.tar.gz'; $so_fake = 'mod_perl-dev.so'; } $ppd = $ppms . $ppdfile; $tgz = $ppmsx86 . $tgzfile; $so_fetch = $ppmsx86 . $so_fake; } else { my $ans = prompt('Do you need EAPI support for mod_ssl?', 'no'); if ($ans =~ /^n/i) { $ppdfile = 'mod_perl-1.ppd'; $tgzfile = 'mod_perl-1.tar.gz'; $so_fake = 'mod_perl-1.so'; } else { $ppdfile = 'mod_perl-eapi-1.ppd'; $tgzfile = 'mod_perl-eapi-1.tar.gz'; $so_fake = 'mod_perl-eapi-1.so'; } $ppd = $ppms . $ppdfile; $tgz = $ppmsx86 . $tgzfile; $so_fetch = $ppmsx86 . $so_fake; } } my $tmp = $ENV{TEMP} || $ENV{TMP} || '.'; chdir $tmp or die "Cannot chdir to $tmp: $!"; # fetch the ppd and tar.gz files print "Fetching $ppd ..."; getstore($ppd, $ppdfile); print " done!\n"; die "Failed to fetch $ppd" unless -e $ppdfile; print "Fetching $tgz ..."; getstore($tgz, $tgzfile); print " done!\n"; die "Failed to fetch $tgz" unless -e $tgzfile; print "Fetching $so_fetch ..."; getstore($so_fetch, $so_fake); print " done!\n"; die "Failed to fetch $so_fetch" unless -e $so_fake; print "Fetching $checksums ..."; getstore($checksums, $cs); print " done!\n"; die "Failed to fetch $checksums" unless -e $cs; # check CHECKSUMS for the tar.gz and so files my $cksum = load_cs($cs); die "Could not load $cs: $!" unless $cksum; die qq{CHECKSUM check for "$tgzfile" failed.\n} unless (verifyMD5($cksum, $tgzfile)); die qq{CHECKSUM check for "$so_fake" failed.\n} unless (verifyMD5($cksum, $so_fake)); unless ($so_fake eq $so) { rename($so_fake, $so) or die "Rename of $so_fake to $so failed: $!"; } # edit the ppd file to reflect a local installation my $old = $ppdfile . '.old'; rename ($ppdfile, $old) or die "renaming $ppdfile to $old failed: $!"; open(my $oldfh, $old) or die "Cannot open $old: $!"; open(my $newfh, ">$ppdfile") or die "Cannot open $ppdfile: $!"; while (<$oldfh>) { next if /; $eval =~ s/\015?\012/\n/g; close $fh; my $comp = Safe->new(); $cksum = $comp->reval($eval); if ($@) { warn $@; return; } return $cksum; } sub verifyMD5 { my ($cksum, $file) = @_; my ($fh, $is, $should); unless (open($fh, $file)) { warn "Cannot open $file: $!"; return; } binmode($fh); unless ($is = Digest::MD5->new->addfile($fh)->hexdigest) { warn "Could not compute checksum for $file: $!"; close($fh); return; } close($fh); if ($should = $cksum->{$file}->{md5}) { my $test = $is eq $should ? 1 : 0; printf qq{Checksum for "$file" is %s\n}, ($test == 1) ? 'OK.' : 'NOT OK.'; return $test; } else { warn "Checksum data for $file not present in CHECKSUMS.\n"; return; } } sub fix_path { my $file = shift; $file = Win32::GetShortPathName($file); $file =~ s!\\!/!g; return $file; } sub drives { my @drives = (); eval{require Win32API::File;}; return map {"$_:\\"} ('C' .. 'Z') if $@; my @r = Win32API::File::getLogicalDrives(); return unless @r > 0; for (@r) { my $t = Win32API::File::GetDriveType($_); push @drives, $_ if ($t == 3 or $t == 4); } return @drives > 0 ? @drives : undef; }