#!/usr/bin/perl # $Id$ #- 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; use urpm; use urpm::args 'options'; use urpm::msg; use urpm::download (); # Default mirror list our $mirrors = 'http://www.linux-mandrake.com/mirrorsfull.list'; sub usage { my $m = shift; # Translator: The URI types strings 'file:', 'ftp:', 'http:', # Translator: and 'removable:' must not be translated! # Translator: neither the ``with''. # Translator: only what is between can be translated. my $usage = N("usage: urpmi.addmedia [options] [with ] where is one of file:// with ftp://:@/ with ftp:/// with http:/// with removable:// 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 ). ") . N(" --proxy-user - specify user and password to use for proxy authentication (format is ). ") . 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 mandrakelinux-release package. ") . N(" --arch - use specified architecture, the default is arch of mandrakelinux-release package installed. ") . N(" --virtual - create virtual media wich are always up-to-date, only file:// protocol is allowed. ") . N(" --no-md5sum - disable MD5SUM file checking. ") . N(" -c - clean headers cache directory. ") . N(" -f - force generation of hdlist files. "); warn $m ? "$usage\n$m" : $usage; exit 0; } sub main { #- parse /etc/urpmi/mirror.config if present, or use default mandrake mirror. # the --from option overrides this setting. if ($options{mirrors_url}) { $mirrors = $options{mirrors_url}; } elsif (-e "/etc/urpmi/mirror.config") { local $_; open my $fh, "/etc/urpmi/mirror.config"; while (<$fh>) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; /^url\s*=\s*(.*)/ and $mirrors = $1; } close $fh; } $options{force} = 0; $options{noclean} = 1; $options{probe_with} = 'synthesis'; #- no the default is to probe synthesis file. my $urpm = new urpm; urpm::args::parse_cmdline(urpm => $urpm); our ($name, $url, $with, $relative_hdlist) = our @cmdline; #- allow not to give name immediately. $options{distrib} or $url or ($url, $name) = ($name, ''); my ($type) = $url =~ m,^([^:]*)://, or $options{distrib} or 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 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. #- get default value unless already provided. unless ($options{version} && $options{arch}) { my $db = URPM::DB::open; $db->traverse_tag( 'name', [ qw(mandrakelinux-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} =~ m|^.*/([^/]+)/*$|; unlink "$urpm->{cachedir}/partial/$basename"; eval { $urpm->{log}(N("retrieving mirrors at %s ...", $options{from})); $urpm->{sync}( { dir => "$urpm->{cachedir}/partial", quiet => 1, proxy => get_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 () { 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 usage N("no need to give with --distrib"); $urpm->add_distrib_media($name, $url, virtual => $options{virtual}, update => $options{update}); } $urpm->update_media(%options, callback => \&urpm::download::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::download::sync_logger); } } else { $name or usage; if ($with eq "with") { $relative_hdlist or usage N(" missing\n"); } elsif ($type =~ /ftp|http|rsync|ssh/) { $options{probe_with} || $with eq "with" or usage N("`with' missing for network media\n"); } $urpm->add_medium($name, $url, $relative_hdlist, virtual => $options{virtual}, update => $options{update}); $urpm->update_media(%options, callback => \&urpm::download::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::download::sync_logger); } } #- try to umount removable device which may have been mounted. $urpm->try_umounting_removables; } main();