package urpm::cfg; # $Id$ use strict; use warnings; use urpm::util; use urpm::msg 'N'; (our $VERSION) = q($Revision$) =~ /(\d+)/; =head1 NAME urpm::cfg - routines to handle the urpmi configuration files =head1 SYNOPSIS =head1 DESCRIPTION =over =item load_config($file) Reads an urpmi configuration file and returns its contents in a hash ref : { 'medium name 1' => { url => 'http://...', option => 'value', ... } '' => { # global options go here }, } Returns undef() in case of parsing error (and sets C<$urpm::cfg::err> to the appropriate error message.) =item dump_config($file, $config) Does the opposite: write the configuration file, from the same data structure. Returns 1 on success, 0 on failure. =cut #- implementations of the substitutions. arch and release are mdk-specific. #- XXX this is fragile code, it's an heuristic that depends on the format of #- /etc/release my ($arch, $release); sub _init_arch_release () { if (!$arch && !$release) { my $l = cat_('/etc/release') or return undef; ($release, $arch) = $l =~ /release (\d+\.\d+).*for (\w+)/; $release = 'cooker' if $l =~ /cooker/i; warn "$arch $release\n"; } 1; } sub get_arch () { _init_arch_release(); $arch } sub get_release () { _init_arch_release(); $release } sub get_host () { my $h; if (open my $f, '/proc/sys/kernel/hostname') { $h = <$f>; close $f; } else { $h = $ENV{HOSTNAME} || `/bin/hostname`; } chomp $h; $h; } our $err; sub _syntax_error () { $err = N("syntax error in config file at line %s", $.) } sub substitute_back { my ($new, $old) = @_; return $new if !defined($old); return $old if expand_line($old) eq $new; return $new; } my %substitutions; sub expand_line { my ($line) = @_; unless (scalar keys %substitutions) { %substitutions = ( HOST => get_host(), ARCH => get_arch(), RELEASE => get_release(), ); } foreach my $sub (keys %substitutions) { $line =~ s/\$$sub\b/$substitutions{$sub}/g; } return $line; } sub load_config ($;$) { my ($file, $b_norewrite) = @_; my %config; my $priority = 1; my $medium; $err = ''; my @conf_lines = cat_($file) or do { $err = N("unable to read config file [%s]", $file); return }; foreach (@conf_lines) { chomp; next if /^\s*#/; #- comments s/^\s+//; s/\s+$//; $_ = expand_line($_) unless $b_norewrite; if ($_ eq '}') { #-{ if (!defined $medium) { _syntax_error(); return; } $config{$medium}{priority} = $priority++ if $medium ne ''; #- to preserve order undef $medium; next; } if (defined $medium && /{$/) { #-} _syntax_error(); return; } if ($_ eq '{') { #-} Entering a global block $medium = ''; next; } if (/^(.*?[^\\])\s+(?:(.*?[^\\])\s+)?{$/) { #- medium definition $medium = unquotespace $1; if ($config{$medium}) { #- hmm, somebody fudged urpmi.cfg by hand. $err = N("medium `%s' is defined twice, aborting", $medium); return; } $config{$medium}{url} = unquotespace $2; next; } #- config values /^(hdlist |list |with_hdlist |removable |md5sum |limit-rate |excludepath |split-(?:level|length) |priority-upgrade |prohibit-remove |downloader |retry |default-media |(?:curl|rsync|wget|prozilla)-options )\s*:\s*['"]?(.*?)['"]?$/x and $config{$medium}{$1} = $2, next; /^key[-_]ids\s*:\s*['"]?(.*?)['"]?$/ and $config{$medium}{'key-ids'} = $1, next; #- positive flags /^(update|ignore|synthesis|noreconfigure|static|virtual)$/ and $config{$medium}{$1} = 1, next; my ($no, $k, $v); #- boolean options if (($no, $k, $v) = /^(no-)?( verify-rpm |norebuild |fuzzy |allow-(?:force|nodeps) |(?:pre|post)-clean |excludedocs |compress |keep |ignoresize |auto |repackage |strict-arch |nopubkey |resume)(?:\s*:\s*(.*))?$/x ) { my $yes = $no ? 0 : 1; $no = $yes ? 0 : 1; $v = '' unless defined $v; $config{$medium}{$k} = $v =~ /^(yes|on|1|)$/i ? $yes : $no; next; } #- obsolete $_ eq 'modified' and next; } return \%config; } sub dump_config ($$) { my ($file, $config) = @_; my $config_old = load_config($file, 1); my @media = sort { return 0 if $a eq $b; return -1 if $a eq ''; #- global options come first return 1 if $b eq ''; return $config->{$a}{priority} <=> $config->{$b}{priority} || $a cmp $b; } keys %$config; open my $f, '>', $file or do { $err = N("unable to write config file [%s]", $file); return 0; }; foreach my $m (@media) { if ($m) { print $f quotespace($m), ' ', quotespace(substitute_back($config->{$m}{url}, $config_old->{$m}{url})), " {\n"; } else { next if !keys %{$config->{''}}; print $f "{\n"; } foreach (sort grep { $_ && $_ ne 'url' } keys %{$config->{$m}}) { if (/^(update|ignore|synthesis|noreconfigure|static|virtual)$/) { print $f " $_\n"; } elsif ($_ ne 'priority') { print $f " $_: " . substitute_back($config->{$m}{$_}, $config_old->{$m}{$_}) . "\n"; } } print $f "}\n\n"; } close $f; return 1; } #- routines to handle mirror list location #- Default mirror list our $mirrors = 'http://www.mandrivalinux.com/mirrorsfull.list'; sub mirrors_cfg () { foreach (cat_("/etc/urpmi/mirror.config")) { chomp; s/#.*$//; s/^\s*//; s/\s*$//; /^url\s*=\s*(.*)/ and $mirrors = $1; } return 1; } 1; __END__ =back =head1 COPYRIGHT Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA Copyright (C) 2005, 2006 Mandriva SA =cut