Update of /cvsroot/fink/fink/perlmod/Fink
In directory sc8-pr-cvs1:/tmp/cvs-serv6591/perlmod/Fink
Modified Files:
Configure.pm Engine.pm Mirror.pm NetAccess.pm PkgVersion.pm
Validation.pm
Log Message:
Implement fink master mirroring via distfiles.opendarwin.org
(patch# 700260 )
Note: mirror currently has most files, but is not regularly syncing, that will happen
soon.
Index: Configure.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Configure.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- Configure.pm 27 Feb 2003 13:48:06 -0000 1.13
+++ Configure.pm 6 Apr 2003 01:58:24 -0000 1.14
@@ -151,7 +151,7 @@
my ($continent, $country);
my ($keyinfo, @continents, @countries, $key, $listinfo);
my ($mirrorfile, $mirrorname, $mirrortitle);
- my ($all_mirrors, @mirrors, $mirror_labels, $site);
+ my ($all_mirrors, @mirrors, $mirror_labels, $site, $mirror_order);
print "\n";
&print_breaking("Mirror selection");
@@ -175,7 +175,20 @@
return;
}
}
-
+
+ &print_breaking("\nThe Fink team maintains mirrors known as \"Master\"
mirrors, which contain ".
+ "the sources for all fink packages. You can choose
to use these mirrors first, ".
+ "last, never, or mixed in with regular
mirrors. If you don't care, just select the default.\n");
+
+ $mirror_order =
+ &prompt_selection("What mirror order should fink use when downloading sources?",
1,
+ { "MasterFirst" => "Search \"Master\" source mirrors first.",
+ "MasterLast" => "Search \"Master\" source mirrors last.",
+ "MasterNever" => "Never use \"Master\" source mirrors.",
+ "ClosestFirst" => "Search closest source mirrors first.
(combine all mirrors into one set)" },
+ ("MasterFirst", "MasterLast", "MasterNever", "ClosestFirst") );
+ $config->set_param("MirrorOrder", $mirror_order);
+
### step 1: choose a continent
$def_value = $config->param_default("MirrorContinent", "-");
Index: Engine.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Engine.pm,v
retrieving revision 1.93
retrieving revision 1.94
diff -u -d -r1.93 -r1.94
--- Engine.pm 8 Mar 2003 02:54:46 -0000 1.93
+++ Engine.pm 6 Apr 2003 01:58:25 -0000 1.94
@@ -506,7 +506,7 @@
}
foreach $package (@plist) {
- $package->phase_fetch();
+ $package->phase_fetch(0, 0);
}
}
@@ -530,29 +530,79 @@
do_real_list("apropos", @_);
}
+sub parse_fetch_options {
+ my %options =
+ (
+ "norestrictive" => 0,
+ "dryrun" => 0,
+ "wanthelp" => 0,
+ );
+
+ my @temp_ARGV = @ARGV;
+ @[EMAIL PROTECTED];
+ Getopt::Long::Configure(qw(bundling ignore_case require_order no_getopt_compat
prefix_pattern=(--|-)));
+ GetOptions('ignore-restrictive|i' => sub {$options{norestrictive} = 1 }
,
+ 'dry-run|d' => sub
{$options{dryrun} = 1 } ,
+ 'help|h' => sub
{$options{wanthelp} = 1 })
+ or die "fink fetch-missing: unknown option\nType 'fink fetch-missing
--help' for more information.\n";
+
+ if ($options{wanthelp} == 1) {
+ require Fink::FinkVersion;
+ my $finkversion = Fink::FinkVersion::fink_version();
+ print <<"EOF";
+Fink $finkversion
+
+Usage: fink fetch-{missing,all} [options]
+
+Options:
+ -i, --ignore-restrictive - Do not fetch sources for packages with
+ a "Restrictive" license. Useful for mirroring.
+ -p, --dry-run - Prints filename, MD5, list of source URLs, Maintainer
for each package
+ -h, --help - This help text.
+
+EOF
+ die " ";
+ }
+ @_ = @ARGV;
+ @ARGV = @temp_ARGV;
+
+ return %options;
+}
+
+#This sub is currently only used for bootstrap. No command line parsing needed
sub cmd_fetch_missing {
- my ($package, @plist);
+ my ($package, $options, @plist);
@plist = &expand_packages(@_);
if ($#plist < 0) {
die "no package specified for command 'fetch'!\n";
}
-
foreach $package (@plist) {
- $package->phase_fetch(1);
+ $package->phase_fetch(1, 0);
}
}
sub cmd_fetch_all {
my ($pname, $package, $version, $vo);
-
+
+ my (%options, $norestrictive, $dryrun);
+ %options = &parse_fetch_options(@_);
+ $norestrictive = $options{"norestrictive"} || 0;
+ $dryrun = $options{"dryrun"} || 0;
+
foreach $pname (Fink::Package->list_packages()) {
$package = Fink::Package->package_by_name($pname);
$version = &latest_version($package->list_versions());
$vo = $package->get_version($version);
if (defined $vo) {
+ if ($norestrictive && $vo->has_param("license")) {
+ if($vo->param("license") =~
m/Restrictive\s*$/i) {
+ print "Ignoring $pname due to License:
Restrictive\n";
+ next;
+ }
+ }
eval {
- $vo->phase_fetch();
+ $vo->phase_fetch(0, $dryrun);
};
warn "$@" if $@; # turn fatal
exceptions into warnings
}
@@ -560,30 +610,13 @@
}
sub cmd_fetch_all_missing {
- my ($pname, $package, $version, $vo, $norestrictive, $wanthelp, @temp_ARGV);
-
- @temp_ARGV = @ARGV;
- @[EMAIL PROTECTED];
- Getopt::Long::Configure(qw(bundling ignore_case require_order no_getopt_compat
prefix_pattern=(--|-)));
- GetOptions('ignore-restrictive|i' => \$norestrictive,
- 'help|h' =>
\$wanthelp)
- or die "fink fetch-missing: unknown option\nType 'fink fetch-missing
--help' for more information.\n";
-
- if ($wanthelp) {
- require Fink::FinkVersion;
- my $finkversion = Fink::FinkVersion::fink_version();
- print <<"EOF";
-Fink $finkversion
-
-Usage: fink fetch-missing [options]
-
-Options:
- -i, --ignore-restrictive - Do not fetch sources for packages with
- a "Restrictive" license. Useful for mirroring.
- -h, --help - This help text.
-
-EOF
- }
+ my ($pname, $package, $version, $vo);
+ my (%options, $norestrictive, $dryrun);
+
+ %options = &parse_fetch_options(@_);
+ $norestrictive = $options{"norestrictive"} || 0;
+ $dryrun = $options{"dryrun"} || 0;
+
foreach $pname (Fink::Package->list_packages()) {
$package = Fink::Package->package_by_name($pname);
$version = &latest_version($package->list_versions());
@@ -598,13 +631,11 @@
}
}
eval {
- $vo->phase_fetch(1);
+ $vo->phase_fetch(1, $dryrun);
};
warn "$@" if $@; # turn fatal
exceptions into warnings
}
}
- @_ = @ARGV;
- @ARGV = @temp_ARGV;
}
sub cmd_remove {
@@ -1130,7 +1161,7 @@
$item = $deps{$pkgname};
next if $item->[3] == $OP_INSTALL and $item->[2]->is_installed();
if ($item->[3] == $OP_REBUILD or not $item->[2]->is_present()) {
- $item->[2]->phase_fetch(1);
+ $item->[2]->phase_fetch(1, 0);
}
}
Index: Mirror.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Mirror.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- Mirror.pm 27 Feb 2003 13:48:07 -0000 1.7
+++ Mirror.pm 6 Apr 2003 01:58:25 -0000 1.8
@@ -24,7 +24,7 @@
use Fink::Services qw(&prompt_selection
&read_properties &read_properties_multival);
-use Fink::Config qw($config $basepath $libpath);
+use Fink::Config qw($config $libpath);
use strict;
use warnings;
@@ -101,7 +101,7 @@
my $self = {};
bless($self, $class);
- $self->{name} = "-";
+ $self->{name} = "Custom Mirror";
$self->{package} = $package;
my ($key, $url);
@@ -129,6 +129,49 @@
return $self;
}
+### construct from single url (for sites without mirrors, to use master mirrors also)
+
+sub new_from_url {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $url = shift;
+ my $package = shift || "unknown package";
+
+ my $self = {};
+ bless($self, $class);
+
+ $self->{name} = "Original URL";
+ $self->{package} = $package;
+
+ $self->{data}->{"primary"} = [ $url ];
+
+ $self->initialize();
+
+ return $self;
+
+}
+
+### merge master mirror set into this one (used for master 'ClosestFirst' mirror)
+
+sub merge_master_mirror {
+ my $self = shift;
+ my $mirror = shift;
+ my ($key, $list, $url);
+ $DB::single = 1;
+
+ foreach $key (keys %{$mirror->{data}}){
+ s/^/master:/ for @{ $mirror->{data}->{$key} };
+ if (exists $self->{data}->{$key}) {
+ for $url (@{ $mirror->{data}->{$key} }) {
+ push @{$self->{data}->{$key}}, $url;
+ }
+ } else {
+ $self->{data}->{$key} = $mirror->{data}->{$key};
+ }
+ }
+
+ delete $self->{data}->{timestamp};
+}
### self-initialization
@@ -148,12 +191,12 @@
if ($self->{lastused}) {
$url = $self->{lastused};
- $url .= "/" unless $url =~ /\/$/;
+ $url .= "/" unless $url =~ /\/$/;
return $url;
}
$name = $self->{name};
- if ($name ne "-") {
+ if ($name !~ /Custom|Original/) {
# check the configuration for named mirrors
if ($Fink::Config::config->has_param("mirror-$name")) {
$self->{lastused} = $url =
$Fink::Config::config->param("mirror-$name");
@@ -173,7 +216,7 @@
}
# nothing found, not even primaries
- if ($name eq "-") {
+ if ($name =~ /Custom/) {
$name = "custom mirror of ".$self->{package};
} else {
$name = "mirror '$name'";
@@ -186,7 +229,9 @@
sub get_site_retry {
my $self = shift;
- my ($result, $level, @choice_list, $default, $url);
+ my $next_set = shift || "";
+ my $printmode = shift || 0;
+ my ($result, $level, @choice_list, $default, $url, $last_set);
my (@list_country, @list_continent, @list_world);
# hmm, someone called us without calling get_site() on the initial try
@@ -224,20 +269,39 @@
$default = $#choice_list + 1;
}
}
- if ($self->{tries} >= 5) {
+ if (!$printmode && $self->{tries} >= 5) {
$default = 1;
}
-
+ if ($next_set ne "") {
+ push @choice_list, "retry-next";
+ if($#choice_list == 2) { # No more mirrors in this set, default to
next
+ $default = $#choice_list + 1;
+ }
+ }
# ask the user
- $result =
+ if($printmode) {
+ #just printing URLs, never ask, never retry same mirror
+ if($default == 2) {
+ $default = 1;
+ }
+ $result = $choice_list[$default - 1];
+ } else {
+ my $nexttext;
+ if($next_set eq "Original URL") {
+ $nexttext = "Retry using original source URL";
+ } else {
+ $nexttext = "Retry using next mirror set \"$next_set\"";
+ }
+ $result =
&prompt_selection("How do you want to proceed?", $default,
{ "error" => "Give up",
"retry" => "Retry the same
mirror",
"retry-country" => "Retry
another mirror from your country",
"retry-continent" => "Retry
another mirror from your continent",
- "retry-world" => "Retry
another mirror" },
+ "retry-world" => "Retry
another mirror",
+ "retry-next" => $nexttext },
@choice_list);
-
+ }
$url = $self->{lastused};
if ($result eq "error") {
return "";
@@ -255,8 +319,9 @@
if ($#list_world >= 0) {
$url = $list_world[int(rand(scalar(@list_world)))];
}
+ } elsif ($result eq "retry-next") {
+ return $result;
}
-
$self->{lastused} = $url;
$url .= "/" unless $url =~ /\/$/;
return $url;
Index: NetAccess.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/NetAccess.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- NetAccess.pm 27 Feb 2003 13:48:08 -0000 1.20
+++ NetAccess.pm 6 Apr 2003 01:58:26 -0000 1.21
@@ -49,6 +49,7 @@
### download a file to the designated directory
# returns 0 on success, 1 on error
+# Does not allow master mirroring
sub fetch_url {
my $url = shift;
@@ -56,11 +57,12 @@
my ($file, $cmd);
$file = &filename($url);
- return &fetch_url_to_file($url, $file, 0, 0, 0, $downloaddir);
+ return &fetch_url_to_file($url, $file, 0, 0, 0, 1, 0, $downloaddir);
}
### download a file to the designated directory and save it under the
### given name
+# Allows custom & master mirroring
# returns 0 on success, 1 on error
sub fetch_url_to_file {
@@ -69,6 +71,8 @@
my $custom_mirror = shift || 0;
my $tries = shift || 0;
my $cont = shift || 0;
+ my $nomirror = shift || 0;
+ my $dryrun = shift || 0;
my $downloaddir = shift || "$basepath/src";
my ($http_proxy, $ftp_proxy);
my ($url, $cmd, $cont_cmd, $result);
@@ -97,34 +101,62 @@
$ENV{ftp_proxy} = $ftp_proxy;
$ENV{FTP_PROXY} = $ftp_proxy;
}
+
+ my ($mirrorname, $origmirror, $nextmirror);
+ my ($mirrorindex, $mirrororder, @mirror_list);
+ my ($path, $basename, $masterpath);
- my ($mirrorname, $mirror, $path);
- if ($origurl =~ /^mirror\:(\w+)\:(.*)$/) {
+ $mirrorindex = 0;
+ if ($origurl =~ m#^mirror\:(\w+)\:(.*?)([^/]+$)#g) {
$mirrorname = $1;
$path = $2;
+ $basename = $3;
if ($mirrorname eq "custom") {
if (not $custom_mirror) {
die "Source file \"$file\" uses mirror:custom, but the
".
"package doesn't specify a mirror site
list.\n";
}
- $mirror = $custom_mirror;
+ $origmirror = $custom_mirror;
} else {
- $mirror = Fink::Mirror->get_by_name($mirrorname);
+ $origmirror = Fink::Mirror->get_by_name($mirrorname);
+ }
+ if($dryrun) {
+ $origmirror->initialize(); # We want every mirror when printing
}
-
- $url = $mirror->get_site();
- $url .= $path;
-
} else {
- $mirrorname = "";
- $path = $origurl;
- $mirror = 0;
-
- $url = $origurl;
+ # Not a custom mirror, parse a full URL
+ $origurl =~ m|^([^:]+://[^/]+/) # Match
http://domain/ into $1
+ (.*?)
# (optional) Path into $2
+ ([^/]+$)
# Tarball into $3
+ |x;
+ $path = $2;
+ $basename = $3;
+ $origmirror = Fink::Mirror->new_from_url($1);
}
+ # set up the mirror ordering
+ $mirrororder = $config->param_default("MirrorOrder", "MasterFirst");
+ if($mirrororder eq "MasterNever" || $dryrun) {
+ $nomirror = 1;
+ }
+ if($nomirror == 0) {
+ push(@mirror_list, Fink::Mirror->get_by_name("master"));
+ $masterpath = ""; # Add package sections, etc here perhaps?
+ if($mirrororder eq "MasterFirst") {
+ push(@mirror_list, $origmirror);
+ } elsif($mirrororder eq "MasterLast") {
+ unshift(@mirror_list, $origmirror);
+ } elsif($mirrororder eq "ClosestFirst") {
+ $origmirror->merge_master_mirror($mirror_list[0]);
+ $mirror_list[0] = $origmirror;
+ }
+ } else {
+ push(@mirror_list, $origmirror);
+ }
+ $url = $mirror_list[0]->get_site();
+
### if the file already exists, ask user what to do
- if (-f $file && !$cont) {
+ if (-f $file && !$cont && !$dryrun) {
$result =
&prompt_selection("The file \"$file\" already exists, how do
you want to proceed?",
1, # Play it save, assume
redownload as default
@@ -143,10 +175,23 @@
}
while (1) { # retry loop, left with return in case of success
-
+
+ if($mirrorindex < $#mirror_list) {
+ $nextmirror = $mirror_list[$mirrorindex + 1]->{name};
+ } else {
+ $nextmirror = "";
+ }
+
+ if(($url =~ /^master:/) || ($mirror_list[$mirrorindex]->{name} eq
"master")) {
+ $url =~ s/^master://;
+ $url .= $masterpath . $file; # SourceRenamed tarball name
+ } else {
+ $url .= $path . $basename;
+ }
+
### fetch $url to $file
- if (-f $file) {
+ if (!$dryrun && -f $file) {
if (not $cont) {
&execute("rm -f $file");
}
@@ -154,14 +199,16 @@
$cont = 0;
}
- if ($cont) {
+ if ($dryrun) {
+ print " $url";
+ } elsif ($cont) {
$result = &execute("$cont_cmd $url");
$cont = 0;
} else {
$result = &execute("$cmd $url");
}
- if ($result or not -f $file) {
+ if ($dryrun or ($result or not -f $file)) {
# failure, continue loop
} else {
# success, return to caller
@@ -169,40 +216,35 @@
}
### failure handling
+ if(not $dryrun) {
+ &print_breaking("Downloading the file \"$file\" failed.");
+ $tries++;
+ }
- &print_breaking("Downloading the file \"$file\" failed.");
-
- $tries++;
-
- if ($mirror) {
- # let the Mirror object handle this mess...
- $url = $mirror->get_site_retry();
- if (not $url) {
- # user chose to give up
- return 1;
- }
- $url .= $path;
-
- } else {
- $result =
- &prompt_selection("How do you want to proceed?",
- ($tries >= 5) ? 1 : 2,
- { "error" => "Give up",
- "retry" =>
"Retry" },
- "error", "retry");
- if ($result eq "error") {
- return 1;
+ # let the Mirror object handle this mess...
+ RETRY: {
+ $url = $mirror_list[$mirrorindex]->get_site_retry($nextmirror,
$dryrun);
+ }
+ if ($url eq "retry-next") {
+ # Start new mirror with the last used site, or first site
+ $url = $mirror_list[$mirrorindex + 1]->get_site();
+ $mirrorindex++;
+ if($mirrorindex < $#mirror_list) {
+ $nextmirror = $mirror_list[$mirrorindex + 1]->{name};
+ } else {
+ $nextmirror = "";
}
-
- } # using mirrors
-
- }
-
- return 0;
+ } elsif (not $url) {
+ # user chose to give up/out of mirrors
+ return 1;
+ }
+ }
+ return 0;
}
sub download_cmd {
my $url = shift;
+ # $file is the post-SourceRename tarball name
my $file = shift || &filename($url);
my $cont = shift || 0; # Continue a previously started download?
my $cmd;
Index: PkgVersion.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/PkgVersion.pm,v
retrieving revision 1.114
retrieving revision 1.115
diff -u -d -r1.114 -r1.115
--- PkgVersion.pm 4 Apr 2003 10:43:35 -0000 1.114
+++ PkgVersion.pm 6 Apr 2003 01:58:26 -0000 1.115
@@ -436,7 +436,7 @@
if ($self->has_param("Source".$index."-MD5")) {
return $self->param("Source".$index."-MD5");
}
- }
+ }
return "-";
}
@@ -856,6 +856,7 @@
sub phase_fetch {
my $self = shift;
my $conditional = shift || 0;
+ my $dryrun = shift || 0;
my ($i);
if ($self->{_type} eq "bundle" || $self->{_type} eq "nosource" ||
@@ -863,13 +864,13 @@
return;
}
if ($self->{_type} eq "splitoff") {
- ($self->{parent})->phase_fetch($conditional);
+ ($self->{parent})->phase_fetch($conditional, $dryrun);
return;
}
for ($i = 1; $i <= $self->{_sourcecount}; $i++) {
if (not $conditional or not defined $self->find_tarball($i)) {
- $self->fetch_source($i);
+ $self->fetch_source($i,0,0,0,$dryrun);
}
}
}
@@ -879,14 +880,39 @@
my $index = shift;
my $tries = shift || 0;
my $continue = shift || 0;
- my ($url, $file);
+ my $nomirror = shift || 0;
+ my $dryrun = shift || 0;
+ my ($url, $file, $checksum);
chdir "$basepath/src";
$url = $self->get_source($index);
$file = $self->get_tarball($index);
+ if($self->has_param("license")) {
+ if($self->param("license") =~ /Restrictive\s*$/) {
+ $nomirror = 1;
+ }
+ }
+
+ $checksum = $self->get_checksum($index);
+
+ if($dryrun) {
+ print "$file $checksum";
+ } else {
+ if($checksum eq '-') {
+ print "WARNING: No MD5 specified for Source #".$index.
+ " of package
".$self->get_fullname();
+ if ($self->has_param("Maintainer")) {
+ print ' Maintainer: '.$self->param("Maintainer") .
"\n";
+ } else {
+ print "\n";
+ }
+ }
+ }
+
+ if (&fetch_url_to_file($url, $file, $self->get_custom_mirror(),
+ $tries, $continue, $nomirror,
$dryrun)) {
- if (&fetch_url_to_file($url, $file, $self->get_custom_mirror(), $tries,
$continue)) {
if (0) {
print "\n";
&print_breaking("Downloading '$file' from the URL '$url' failed. ".
@@ -908,8 +934,13 @@
"the same command.");
print "\n";
}
-
- die "file download failed for $file of package
".$self->get_fullname()."\n";
+ if($dryrun) {
+ if ($self->has_param("Maintainer")) {
+ print ' "'.$self->param("Maintainer") . "\"\n";
+ }
+ } else {
+ die "file download failed for $file of package
".$self->get_fullname()."\n";
+ }
}
}
@@ -974,8 +1005,8 @@
# verify the MD5 checksum, if specified
$checksum = $self->get_checksum($i);
- if ($checksum ne "-") { # Checksum was specified
- # compare to the MD5 checksum of the tarball
+ if ($checksum ne "-" ) { # Checksum was specified
+ # compare to the MD5 checksum of the tarball
if ($checksum ne &file_MD5_checksum($found_archive)) {
# mismatch, ask user what to do
$tries++;
Index: Validation.pm
===================================================================
RCS file: /cvsroot/fink/fink/perlmod/Fink/Validation.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- Validation.pm 30 Mar 2003 13:26:18 -0000 1.41
+++ Validation.pm 6 Apr 2003 01:58:26 -0000 1.42
@@ -274,10 +274,10 @@
}
}
- # Warn if there is a source without a MD5
+ # Error if there is a source without a MD5
if (($field eq "source" or $field =~ m/^source([2-9]|\d\d)$/)
and not $properties->{$field."-md5"}) {
- print "Warning: No MD5 checksum specified for \"$field\".
($filename)\n";
+ print "Error: No MD5 checksum specified for \"$field\".
($filename)\n";
$looks_good = 0;
}
-------------------------------------------------------
This SF.net email is sponsored by: ValueWeb:
Dedicated Hosting for just $79/mo with 500 GB of bandwidth!
No other company gives more support or power for your dedicated server
http://click.atdmt.com/AFF/go/sdnxxaff00300020aff/direct/01/
_______________________________________________
Fink-commits mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/fink-commits
