diff options
author | Norbert Preining <preining@logic.at> | 2010-05-11 11:42:56 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-11 11:42:56 +0000 |
commit | 84b958df892c3589ae527aa37413c50f7001c55a (patch) | |
tree | ca2fcf7954c52e606cc874ed20b9cdd0284da75e | |
parent | 0f0e478dba51669836f1a6f3078a27c64816f151 (diff) |
add beginning on new work on mutli-source support
git-svn-id: svn://tug.org/texlive/trunk@18197 c570f23f-e606-0410-a88d-b1316a301751
4 files changed, 530 insertions, 0 deletions
diff --git a/Master/tlpkg/dev/dev.multi-source-support.patches/001-extend-tlpdb-option-location-field-add-action b/Master/tlpkg/dev/dev.multi-source-support.patches/001-extend-tlpdb-option-location-field-add-action new file mode 100644 index 00000000000..aa280988c7d --- /dev/null +++ b/Master/tlpkg/dev/dev.multi-source-support.patches/001-extend-tlpdb-option-location-field-add-action @@ -0,0 +1,128 @@ +Allow more than one repository in the tlpdb/option-location field +The format is: + repo1[#tag] repo2[#tag] ... +the tags are optional. +This patch only adds support for a new action "repository" that lists, +adds, removes, sets repositories according to this format. +It does not change tlmgr to allow actually working with it. +--- + texmf/scripts/texlive/tlmgr.pl | 99 +++++++++++++++++++++++++++++++++++++++++ + 1 file changed, 99 insertions(+) + +Index: Master/texmf/scripts/texlive/tlmgr.pl +=================================================================== +--- Master.orig/texmf/scripts/texlive/tlmgr.pl 2010-05-02 01:31:56.000000000 +0900 ++++ Master/texmf/scripts/texlive/tlmgr.pl 2010-05-02 01:32:12.000000000 +0900 +@@ -455,6 +455,9 @@ + } elsif ($action =~ m/^option$/i) { + action_option(); + finish(0); ++ } elsif ($action =~ m/^repository$/i) { ++ action_repository(); ++ finish(0); + } elsif ($action =~ m/^list$/i) { + action_list(); + finish(0); +@@ -2839,6 +2842,102 @@ + return; + } + ++# REPOSITORY ++# ++# this action manages the list of repositories ++# tlmgr repository list -> lists repositories ++# tlmgr repository add path [tag] -> add repository with optional tag ++# tlmgr repository remove [path|tag] -> removes repository or tag ++# tlmgr repository set path[#tag] [path[#tag] ...] -> sets the list ++# ++ ++sub array_to_repository { ++ my %r = @_; ++ my @ret; ++ for my $k (keys %r) { ++ my $v = $r{$k}; ++ if ($k eq $v) { ++ push @ret, $k; ++ } else { ++ push @ret, "$v#$k"; ++ } ++ } ++ return "@ret"; ++} ++sub repository_to_array { ++ my $r = shift; ++ my %r; ++ for my $rr (split ' ', $r) { ++ if ($rr =~ m/^([^#]+)#(.*)$/) { ++ $r{$2} = $1; ++ } else { ++ $r{$rr} = $rr; ++ } ++ } ++ return %r; ++} ++sub action_repository { ++ init_local_db(); ++ my $what = shift @ARGV; ++ my %repos = repository_to_array($localtlpdb->option("location")); ++ if ($what =~ m/^list$/i) { ++ print "List of repositories (with tags if set):\n"; ++ for my $k (keys %repos) { ++ my $v = $repos{$k}; ++ print "\t$v"; ++ if ($k ne $v) { ++ print " ($k)"; ++ } ++ print "\n"; ++ } ++ return; ++ } ++ if ($what eq "add") { ++ my $p = shift @ARGV; ++ if (!defined($p)) { ++ tlwarn("You need to give a new repository aas argument to add\n"); ++ return; ++ } ++ my $t = shift @ARGV; ++ $t = $p if (!defined($t)); ++ if (defined($repos{$t})) { ++ tlwarn("This repository or its tag is already defined, no action\n"); ++ return; ++ } ++ # TODO more checks needed? ++ $repos{$t} = $p; ++ $localtlpdb->option("location", array_to_repository(%repos)); ++ $localtlpdb->save; ++ return; ++ } ++ if ($what eq "remove") { ++ my $p = shift @ARGV; ++ if (!defined($p)) { ++ tlwarn("Which repository should be removed?\n"); ++ return; ++ } ++ my $found = 0; ++ for my $k (keys %repos) { ++ if ($k eq $p || $repos{$k} eq $p) { ++ $found = 1; ++ delete $repos{$k}; ++ } ++ } ++ if (!$found) { ++ tlwarn("Cannot find the repository $p\n"); ++ } else { ++ $localtlpdb->option("location", array_to_repository(%repos)); ++ $localtlpdb->save; ++ } ++ return; ++ } ++ if ($what eq "set") { ++ %repos = repository_to_array("@ARGV"); ++ $localtlpdb->option("location", array_to_repository(%repos)); ++ $localtlpdb->save; ++ } ++} ++ + + # OPTION + # diff --git a/Master/tlpkg/dev/dev.multi-source-support.patches/010-add-action-candidates-mediahash b/Master/tlpkg/dev/dev.multi-source-support.patches/010-add-action-candidates-mediahash new file mode 100644 index 00000000000..bbfee51b84e --- /dev/null +++ b/Master/tlpkg/dev/dev.multi-source-support.patches/010-add-action-candidates-mediahash @@ -0,0 +1,243 @@ +Add tlmediasrcs etc hashes that collect all the available hashes, and +add init_tlmedias that initializes all these hashs. +Adapt init_tlmedia to work in both cases (old style/new style) +add action "candidates" for checking which packages are available +--- + texmf/scripts/texlive/tlmgr.pl | 123 ++++++++++++++++++++++++++++++++++------- + 1 file changed, 102 insertions(+), 21 deletions(-) + +Index: Master/texmf/scripts/texlive/tlmgr.pl +=================================================================== +--- Master.orig/texmf/scripts/texlive/tlmgr.pl 2010-05-02 02:02:39.000000000 +0900 ++++ Master/texmf/scripts/texlive/tlmgr.pl 2010-05-02 02:02:43.000000000 +0900 +@@ -91,8 +91,13 @@ + + our %config; # hash of config settings from config file + our $tlmediasrc; # media from which we install/update ++our %tlmediasrcs; + our $tlmediatlpdb; ++our %tlmediatlpdbs; + our $location; # location from which the new packages come ++our %locations; ++# hash with *all* installable packages as keys and source as value ++our %media_packages; + our $localtlmedia; # local installation which we are munging + our $localtlpdb; # local installation which we are munging + +@@ -458,6 +463,9 @@ + } elsif ($action =~ m/^repository$/i) { + action_repository(); + finish(0); ++ } elsif ($action =~ m/^candidates$/i) { ++ action_candidates(); ++ finish(0); + } elsif ($action =~ m/^list$/i) { + action_list(); + finish(0); +@@ -3120,6 +3128,32 @@ + } + + ++# CANDIDATES ++# ++sub action_candidates { ++ init_local_db(1); ++ init_tlmedias(); ++ foreach my $pkg (@ARGV) { ++ my @l = (); ++ for my $s (keys %tlmediasrcs) { ++ info("trying $s ...\n"); ++ my $tlp = $tlmediatlpdbs{$s}->get_package($pkg); ++ if ($tlp) { ++ push @l, "$s (" . $tlp->revision . ")"; ++ } ++ } ++ if (@l) { ++ info("$pkg:\n"); ++ for my $f (@l) { ++ info("\t$f\n"); ++ } ++ } else { ++ info("No installation candidate for $pkg\n"); ++ } ++ } ++} ++ ++ + # ARCH + # + sub action_arch { +@@ -4228,28 +4262,53 @@ + } + + ++sub init_tlmedias ++{ ++ %locations = repository_to_array($localtlpdb->option("location")); ++ for my $l (keys %locations) { ++ printf "Init $l\n"; ++ init_tlmedia($l); ++ } ++} ++ + # initialize the global $tlmediasrc object, or die. + # uses the global $location. + # + sub init_tlmedia + { +- if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $location)) { ++ my $tag = shift; ++ # defaults for normal operation with one location setting ++ my $loc = $location; ++ my $tlmdb = $tlmediatlpdb; ++ # if a tag is given, so called via init_tlmedias, redefine the settings ++ if (defined($tag)) { ++ $loc = $locations{$tag}; ++ $tlmdb = $tlmediatlpdbs{$tag}; ++ } ++ ++ ++ if (defined($tlmdb) && ($tlmdb->root eq $loc)) { + # nothing to be done + return; + } + + # choose a mirror if we are asked. +- if ($location =~ m/^ctan$/i) { +- $location = give_ctan_mirror(); +- } elsif ($location =~ m,^$TeXLiveServerURL,) { ++ if ($loc =~ m/^ctan$/i) { ++ $loc = give_ctan_mirror(); ++ } elsif ($loc =~ m,^$TeXLiveServerURL,) { + my $mirrorbase = TeXLive::TLUtils::give_ctan_mirror_base(); +- $location =~ s,^$TeXLiveServerURL,$mirrorbase,; ++ $loc =~ s,^$TeXLiveServerURL,$mirrorbase,; ++ } ++ # ++ # if we are in the normal case do not forget to update the locations ++ if (!defined($tag)) { ++ $location = $loc; + } + + # this "location-url" line should not be changed since GUI programs + # depend on it: +- print "location-url\t$location\n" if $::machinereadable; +- info("tlmgr: package repository $location\n"); ++ print "location-url\t$loc\n" if $::machinereadable; ++ info("tlmgr: package repository $loc\n"); + + # if we talk about a net location try to download the hash of the tlpdb + # - if that is possible, check for the locally saved file and if the hash +@@ -4260,9 +4319,9 @@ + # not work + + my $local_copy_tlpdb_used = 0; +- if ($location =~ m;^(http|ftp)://;) { ++ if ($loc =~ m;^(http|ftp)://;) { + # first check that the saved tlpdb is present at all +- my $loc_digest = Digest::MD5::md5_hex($location); ++ my $loc_digest = Digest::MD5::md5_hex($loc); + my $loc_copy_of_remote_tlpdb = + "$Master/$InfraLocation/texlive.tlpdb.$loc_digest"; + ddebug("loc_digest = $loc_digest\n"); +@@ -4271,7 +4330,7 @@ + ddebug("loc copy found!\n"); + # we found the tlpdb matching the current location + # check for the remote hash +- my $path = "$location/$InfraLocation/$DatabaseName.md5"; ++ my $path = "$loc/$InfraLocation/$DatabaseName.md5"; + ddebug("remote path of digest = $path\n"); + my $fh = TeXLive::TLUtils::download_file($path, "|"); + my $rem_digest; +@@ -4288,8 +4347,14 @@ + END_NO_INTERNET + # above text duplicated in TLPDB.pm, sorry. + +- $tlmediasrc = TeXLive::TLMedia->new(-location => $location, +- -tlpdbfile => $loc_copy_of_remote_tlpdb); ++ if (defined($tag)) { ++ $tlmediasrcs{$tag} = TeXLive::TLMedia->new(-location => $loc, ++ -tlpdbfile => $loc_copy_of_remote_tlpdb); ++ } else { ++ $tlmediasrc = TeXLive::TLMedia->new(-location => $loc, ++ -tlpdbfile => $loc_copy_of_remote_tlpdb); ++ } ++ + $local_copy_tlpdb_used = 1; + } else { + ddebug("found remote digest: $rem_digest\n"); +@@ -4297,8 +4362,13 @@ + ddebug("rem_copy_digest = $rem_copy_digest\n"); + if ($rem_copy_digest eq $rem_digest) { + debug("md5 of local copy identical with remote hash\n"); +- $tlmediasrc = TeXLive::TLMedia->new(-location => $location, ++ if (defined($tag)) { ++ $tlmediasrcs{$tag} = TeXLive::TLMedia->new(-location => $loc, + -tlpdbfile => $loc_copy_of_remote_tlpdb); ++ } else { ++ $tlmediasrc = TeXLive::TLMedia->new(-location => $loc, ++ -tlpdbfile => $loc_copy_of_remote_tlpdb); ++ } + $local_copy_tlpdb_used = 1; + } + } +@@ -4306,23 +4376,34 @@ + } + if (!$local_copy_tlpdb_used) { + # $tlmediasrc is a global variable +- $tlmediasrc = TeXLive::TLMedia->new(-location => $location); ++ if (defined($tag)) { ++ $tlmediasrcs{$tag} = TeXLive::TLMedia->new(-location => $loc); ++ } else { ++ $tlmediasrc = TeXLive::TLMedia->new(-location => $loc); ++ } ++ } ++ if (defined($tag)) { ++ die($loadmediasrcerror . $location) unless defined($tlmediasrcs{$tag}); ++ $tlmediatlpdbs{$tag} = $tlmediasrcs{$tag}->tlpdb; ++ $tlmdb = $tlmediatlpdbs{$tag}; ++ } else { ++ die($loadmediasrcerror . $location) unless defined($tlmediasrc); ++ $tlmediatlpdb = $tlmediasrc->tlpdb; ++ $tlmdb = $tlmediatlpdb; + } +- die($loadmediasrcerror . $location) unless defined($tlmediasrc); +- $tlmediatlpdb = $tlmediasrc->tlpdb; + # if the release from the remote TLPDB does not agree with the + # TLConfig::ReleaseYear in the first 4 places break out here. + # Why only the first four places: some optional network distributions + # might use + # release/2009-foobar +- my $texlive_release = $tlmediatlpdb->config_release; ++ my $texlive_release = $tlmdb->config_release; + if (!defined($texlive_release) || + $texlive_release !~ m/^$TeXLive::TLConfig::ReleaseYear/) { + die "The release version of the installation source and the installation media\ndo not agree: source: $texlive_release, media: $TeXLive::TLConfig::ReleaseYear\nPlease fix your location $location"; + } + + # check for being frozen +- if ($tlmediatlpdb->option("frozen")) { ++ if ($tlmdb->option("frozen")) { + my $frozen_msg = <<FROZEN; + TeX Live $TeXLive::TLConfig::ReleaseYear is frozen and will not be + updated anymore. This happens in preparation for a new release. +@@ -4337,8 +4418,8 @@ + # save remote database if it is a net location + # make sure that the writeout of the tlpdb is done in UNIX mode + # since otherwise the sha256 will change. +- if (!$local_copy_tlpdb_used && $location =~ m;^(http|ftp)://;) { +- my $loc_digest = Digest::MD5::md5_hex($location); ++ if (!$local_copy_tlpdb_used && $loc =~ m;^(http|ftp)://;) { ++ my $loc_digest = Digest::MD5::md5_hex($loc); + my $loc_copy_of_remote_tlpdb = + "$Master/$InfraLocation/texlive.tlpdb.$loc_digest"; + my $tlfh; +@@ -4349,7 +4430,7 @@ + &debug("Cannot save remote TeX Live database to $loc_copy_of_remote_tlpdb: $!\n"); + } else { + &debug("writing out tlpdb to $loc_copy_of_remote_tlpdb\n"); +- $tlmediatlpdb->writeout($tlfh); ++ $tlmdb->writeout($tlfh); + close($tlfh); + } + } diff --git a/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support b/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support new file mode 100644 index 00000000000..fabbfc6ad49 --- /dev/null +++ b/Master/tlpkg/dev/dev.multi-source-support.patches/020-add-pinning-file-support @@ -0,0 +1,156 @@ +add support for TEXMFSYSCONFIG/tlmgr/pinning +show the available pins in tlmgr candidate and mark the winning one with * +--- + texmf/scripts/texlive/tlmgr.pl | 102 +++++++++++++++++++++++++++++++++++++++-- + 1 file changed, 99 insertions(+), 3 deletions(-) + +Index: Master/texmf/scripts/texlive/tlmgr.pl +=================================================================== +--- Master.orig/texmf/scripts/texlive/tlmgr.pl 2010-05-05 03:22:16.000000000 +0900 ++++ Master/texmf/scripts/texlive/tlmgr.pl 2010-05-05 03:22:24.000000000 +0900 +@@ -71,6 +71,7 @@ + + use Cwd qw/abs_path/; + use Digest::MD5; ++use Text::Glob qw( match_glob); + use Pod::Usage; + use Getopt::Long qw(:config no_autoabbrev permute); + use strict; +@@ -90,6 +91,7 @@ + binmode(STDERR, ":utf8"); + + our %config; # hash of config settings from config file ++our %Pin; # $pin{$tag}{$package} + our $tlmediasrc; # media from which we install/update + our %tlmediasrcs; + our $tlmediatlpdb; +@@ -333,6 +335,9 @@ + # load the config file and set the config options + # load it BEFORE starting downloads as we seet persistent-downloads there! + load_config_file(); ++ # ++ # load pinning file ++ load_pinning_file(); + + # + # if we are asked to use persistent connections try to start it here +@@ -3134,18 +3139,28 @@ + init_local_db(1); + init_tlmedias(); + foreach my $pkg (@ARGV) { +- my @l = (); ++ my %pkgpin = (); ++ my %revs = (); ++ my $maxsrc = ""; ++ my $maxpin = "-1"; + for my $s (keys %tlmediasrcs) { + info("trying $s ...\n"); + my $tlp = $tlmediatlpdbs{$s}->get_package($pkg); + if ($tlp) { +- push @l, "$s (" . $tlp->revision . ")"; ++ $revs{$s} = $tlp->revision; ++ $pkgpin{$s} = get_pin($s,$pkg); ++ if ($maxpin < $pkgpin{$s}) { ++ $maxsrc = $s; ++ $maxpin = $pkgpin{$s}; ++ } + } + } ++ my @l = sort keys %pkgpin; + if (@l) { + info("$pkg:\n"); + for my $f (@l) { +- info("\t$f\n"); ++ info(($f eq $maxsrc ? "\t*" : "\t ")); ++ info("$f ($revs{$f}) [$pkgpin{$f}]\n"); + } + } else { + info("No installation candidate for $pkg\n"); +@@ -4541,6 +4556,87 @@ + close(TLC); + } + ++# ++# pinning file handling ++# location ++# TEXMFSYSCONFIG/tlmgr/pinning ++# (it is only globally useful!) ++# format ++# # are comments ++# empty lines are ignored ++# package:tag:pin ++# where package is a glob, tag a tag (no * allowed, what for!), ++# pin between 0 and 1000 ++# tags identify repositories, so they can also be the urls ++# ++# ++# Format in memory: ++# $Pin{$tag}{$package} but $tag can NOT be "*" ++# ++sub load_pinning_file ++{ ++ # ++ chomp (my $TEXMFSYSCONFIG = `kpsewhich -var-value=TEXMFSYSCONFIG`); ++ my $fn = "$TEXMFSYSCONFIG/tlmgr/pinning"; ++ if (-r $fn) { ++ if (!open(TLC, "<$fn")) { ++ tlwarn("Cannot open $fn: $!"); ++ return; ++ } ++ while (<TLC>) { ++ if (m/^\s*$/) { next; } ++ if (m/^\s*#/) { next; } ++ # TODO ++ # check that we can enter all URL chars in [\w-]+ ?! ++ if (m/^\s*([*\w-]+)\s*:\s*([\w-]+)\s*:\s*([*\w-]+)\s*$/) { ++ my $package = $1; ++ my $tag = $2; ++ my $pin = $3; ++ if ($pin !~ m/^[0-9]+/) { ++ tlwarn("Pin $pin is not numeric, ignoring it.\n"); ++ next; ++ } ++ if ($pin < 0 || $pin > 1000) { ++ tlwarn ("Pin $pin out of range (0-1000), ignoring.\n"); ++ next; ++ } ++ $Pin{$tag}{$package} = $pin; ++ next; ++ } ++ tlwarn("I cannot understand the following line in $fn:\n$_\n"); ++ next; ++ } ++ close(TLC); ++ } ++} ++ ++sub match_package ++{ ++ my ($package, $p) = @_; ++ return 1 if match_glob( $p, $package); ++} ++ ++# ++# compute the pin of $package/$tag ++sub get_pin ++{ ++ my ($tag, $package) = @_; ++ # the following three pins collect that pins set by: ++ my $pin; ++ if (defined($Pin{$tag})) { ++ # for this tag some pin specifications are provided, go through ++ # all of them and check them ++ my %foo = %{$Pin{$tag}}; ++ for my $p (keys %foo) { ++ $pin = $foo{$p} if match_package($package, $p); ++ } ++ return $pin if defined($pin); ++ } ++ # default pin ++ return 500; ++} ++ ++ + # if the packagelog variable is set then write to PACKAGELOG filehandle + # + sub logpackage diff --git a/Master/tlpkg/dev/dev.multi-source-support.patches/series b/Master/tlpkg/dev/dev.multi-source-support.patches/series new file mode 100644 index 00000000000..401444ab933 --- /dev/null +++ b/Master/tlpkg/dev/dev.multi-source-support.patches/series @@ -0,0 +1,3 @@ +001-extend-tlpdb-option-location-field-add-action +010-add-action-candidates-mediahash +020-add-pinning-file-support |