#!/usr/bin/perl #- Copyright (C) 2000 MandrakeSoft (fpons@mandrakesoft.com) #- #- This program is free software; you can redistribute it and/or modify #- it under the terms of the GNU General Public License as published by #- the Free Software Foundation; either version 2, or (at your option) #- any later version. #- #- This program is distributed in the hope that it will be useful, #- but WITHOUT ANY WARRANTY; without even the implied warranty of #- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #- GNU General Public License for more details. #- #- You should have received a copy of the GNU General Public License #- along with this program; if not, write to the Free Software #- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #- this program is based upon old urpmi.addmedia #use strict qw(subs vars refs); use urpm; sub main { my ($name, $url, $with, $relative_hdlist, %options); #- parse /etc/urpmi/mirror.config if present, or use default mandrake mirror. my $mirrors = 'http://www.linux-mandrake.com/mirrorsfull.list'; if (-e "/etc/urpmi/mirror.config") { local (*F, $_); open F, "/etc/urpmi/mirror.config"; while (<F>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; /^url\s*=\s*(.*)/ and $mirrors = $1; } close F; } # Translator: The URI types strings 'file:', 'ftp:', 'http:', # Translator: and 'removable:' must not be translated! # Translator: neither the ``with''. # Translator: only what is between <brakets> can be translated. my $usage = N("usage: urpmi.addmedia [options] <name> <url> [with <relative_path>] where <url> is one of file://<path> ftp://<login>:<password>@<host>/<path> with <relative filename of hdlist> ftp://<host>/<path> with <relative filename of hdlist> http://<host>/<path> with <relative filename of hdlist> removable://<path> and [options] are from ") . N(" --help - print this help message. ") . N(" --wget - use wget to retrieve distant files. ") . N(" --curl - use curl to retrieve distant files. ") . N(" --limit-rate - limit the download speed. ") . N(" --proxy - use specified HTTP proxy, the port number is assumed to be 1080 by default (format is <proxyhost[:port]>). ") . N(" --proxy-user - specify user and password to use for proxy authentication (format is <user:password>). ") . N(" --update - create an update medium. ") . N(" --probe-synthesis - try to find and use synthesis file. ") . N(" --probe-hdlist - try to find and use hdlist file. ") . N(" --no-probe - do not try to find any synthesis or hdlist file. ") . N(" --distrib - automatically create all media from an installation medium. ") . N(" --distrib-XXX - automatically create a medium for XXX part of a distribution, XXX may be main, contrib, updates or anything else that has been configured ;-) ") . N(" --from - use specified url for list of mirrors, the default is %s ", $mirrors) . N(" --version - use specified distribution version, the default is taken from the version of the distribution told by the installed mandrake-release package. ") . N(" --arch - use specified architecture, the default is arch of mandrake-release package installed. ") . N(" --virtual - create virtual media wich are always up-to-date, only file:// protocol is allowed. ") . N(" -c - clean headers cache directory. ") . N(" -f - force generation of hdlist files. "); $options{force} = 0; $options{noclean} = 1; $options{probe_with} = 'synthesis'; #- no the default is to probe synthesis file. my $urpm = new urpm; while ($_ = shift @_) { /^--?c/ and $options{noclean} = 0, next; /^--?h/ and next; /^--?f/ and ++$options{force}, next; /^--wget/ and $urpm->{sync} = sub { my $options = shift @_; if (ref $options) { $options->{prefer} = 'wget' } else { $options = { dir => $options, prefer => 'wget' } } urpm::sync_webfetch($options, @_) }, next; /^--curl/ and $urpm->{sync} = \&urpm::sync_webfetch, next; /^--limit-rate$/ and do { $options{limit_rate} = shift @_; next }; /^--proxy$/ and do { my ($proxy, $port) = ($_ = shift @_) =~ m,^(?:http://)?([^:]+(:\d+)?)/*$, or die N("bad proxy declaration on command line\n"); $proxy .= ":1080" unless $port; $urpm->{proxy}{http_proxy} = $proxy; next; }; /^--proxy-user$/ and do { ($_ = shift @_) =~ /(.+):(.+)/, or die N("bad proxy declaration on command line\n"); $urpm->{proxy}{user} = $1; $urpm->{proxy}{pwd} = $2; next; }; /^--probe-synthesis/ and $options{probe_with} = 'synthesis', next; /^--probe-hdlist/ and $options{probe_with} = 'hdlist', next; /^--no-probe/ and $options{probe_with} = undef, next; /^--distrib$/ and $options{distrib} = undef, next; /^--distrib-(.*)$/ and $options{distrib} = $1, next; /^--from$/ and $options{mirrors_url} = shift @_, next; /^--version$/ and $options{version} = shift @_, next; /^--arch$/ and $options{arch} = shift @_, next; /^--update$/ and $options{update} = 1, next; /^--virtual$/ and $options{virtual} = 1, next; /^-/ and die $usage . N("\nunknown options '%s'\n", $_); ($name, $url, $with, $relative_hdlist) = ($_, @_); last; } #- allow not to give name immediately. $options{distrib} or $url or ($url, $name) = ($name, ''); my ($type) = $url =~ m,^([^:]*)://, or $options{distrib} or die $usage; $urpm->read_config; exists $options{limit_rate} or $options{limit_rate} = $urpm->{options}{'limit-rate'}; if (exists $options{distrib}) { if (defined $options{distrib}) { $name or die $usage; #- extended distribution support, code is directly inlined here. #- -h always set, updates should allow setting update flag. $options{distrib} eq 'updates' and $options{update} = 1; #- official site by default. $options{from} ||= $mirrors; #- get default value unless already provided. unless ($options{version} && $options{arch}) { my $db = URPM::DB::open; $db->traverse_tag('name', [ qw(mandrake-release basesystem) ], sub { my ($pkg) = @_; $pkg->release =~ /0\./ and $options{version} ||= 'cooker'; $options{version} ||= $pkg->version; $pkg->arch ne 'noarch' and $options{arch} ||= $pkg->arch; }); } #- sanity checks... $options{distrib} eq 'updates' && $options{version} eq 'cooker' and die N("cannot add updates of a cooker distribution\n"); #- get mirrors list file in urpmi cache. my ($basename) = $options{from} =~ /^.*\/([^\/]+)\/*$/; unlink "$urpm->{cachedir}/partial/$basename"; eval { $urpm->{log}(N("retrieving mirrors at %s ...", $options{from})); $urpm->{sync}({ dir => "$urpm->{cachedir}/partial", quiet => 1, proxy => $urpm->{proxy} }, $options{from}); $urpm->{log}(N("...retrieving done")); }; $@ and $urpm->{log}(N("...retrieving failed: %s", $@)); #- examine its contents and create all requested media, url is now a simple regex. my $heading = quotemeta($options{distrib}); my $qarch = quotemeta($options{arch}); local *F; open F, "$urpm->{cachedir}/partial/$basename"; while (<F>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; my ($v, $a, $l, $burl, $relative_hdlist); if (($v, $a, $l, $burl, $relative_hdlist) = /^$heading:([^:]*):([^:]*):([^:]*):(\S*)(?:\s+with\s+(.*))?$/) { $v eq '*' || $v eq $options{version} or next; $a eq '*' || $a eq $options{arch} or next; } elsif (($a, $burl) = /^$heading([^:]*):(\S*)$/) { $a eq $options{arch} or next; $options{distrib} eq 'updates' and $burl = "$burl/$options{version}/RPMS"; $options{distrib} eq 'contrib' and $burl .= "2"; } elsif (($a, $burl) = /^cooker([^:]*):(\S*)$/) { #- specific case for old style mirrors file description (of Mandrake). $options{version} eq 'cooker' && $options{distrib} eq 'contrib' or next; $a eq $options{arch} or next; $burl .= "2"; } else { # it could a blank line (from a commentary) or source description. next; } #- sort according to url or location if possible. !$url || $l && $l =~ /$url/i || $burl =~ /$url/i or next; $urpm->add_medium($name, $burl, $relative_hdlist, virtual => $options{virtual}, update => $options{update}, index_name => 0); } close F; } else { $with || $relative_hdlist and die N("%s\nno need to give <relative path of hdlist> with --distrib", $usage); $urpm->add_distrib_media($name, $url, virtual => $options{virtual}, update => $options{update}); } $urpm->update_media(%options, callback => \&urpm::sync_logger); if (my @unsynced_media = grep { $_->{modified} } @{$urpm->{media}}) { print STDERR join("\n", map { N("unable to update medium \"%s\"\n", $_->{name}) } @unsynced_media); #- remove quietly the failing media. $urpm->{log} = sub {}; $urpm->remove_selected_media; $urpm->update_media(%options, callback => \&urpm::sync_logger); } } else { $name or die $usage; if ($with eq "with") { $relative_hdlist or die N("%s\n<relative path of hdlist> missing\n", $usage); } elsif ($type =~ /ftp|http|rsync|ssh/) { $options{probe_with} || $with eq "with" or die N("%s\n`with' missing for network media\n", $usage); } $urpm->add_medium($name, $url, $relative_hdlist, virtual => $options{virtual}, update => $options{update}); $urpm->update_media(%options, callback => \&urpm::sync_logger); #- check creation of media (during update has been successfull) my ($medium) = grep { $_->{name} eq $name } @{$urpm->{media}}; $medium or die N("unable to create medium \"%s\"\n", $name); if ($medium->{modified}) { print STDERR N("unable to update medium \"%s\"\n", $name); #- remove quietly the failing media. $urpm->{log} = sub {}; $urpm->remove_selected_media; $urpm->update_media(%options, callback => \&urpm::sync_logger); } } #- try to umount removable device which may have been mounted. $urpm->try_umounting_removables; } main(@ARGV);