summaryrefslogtreecommitdiffstats
path: root/perl-install/scanner.pm
blob: be972a260491924206cf7e763616f7f59a83dbfa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
package scanner;
# scanner.pm $Id$
# Yves Duret <yduret at mandriva.com>
# Till Kamppeter <till at mandriva.com>
# Copyright (C) 2001-2004 Mandriva
#
# 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.
#
# pbs/TODO:
# - scsi mis-configuration (should work better now)
# - with 2 scanners same manufacturer -> will overwrite previous conf -> only 1 conf !! (should work now)
# - lp: see printerdrake
# - install: prefix --> done (partially)

use common;
use detect_devices;
use log;
use handle_configs;

my $sanedir = "$::prefix/etc/sane.d";
my $scannerDBdir = "$::prefix$ENV{SHARE_PATH}/ldetect-lst";
our $scannerDB = readScannerDB("$scannerDBdir/ScannerDB");

sub confScanner {
    my ($model, $port, $vendor, $product, $firmware) = @_;
    $port ||= "$::prefix/dev/scanner";
    my $a = $scannerDB->{$model}{server};
    #print "file:[$a]\t[$model]\t[$port]\n| ", (join "\n| ", @{$scannerDB->{$model}{lines}}),"\n";
    my @driverconf = cat_("$sanedir/$a.conf");
    my @configlines = @{$scannerDB->{$model}{lines}};
    foreach my $line (@configlines) {
	$line =~ s/\$DEVICE/$port/g if $port;
	next if $line =~ /\$DEVICE/;
	$line =~ s/\$VENDOR/$vendor/g if $vendor;
	next if $line =~ /\$VENDOR/;
	$line =~ s/\$PRODUCT/$product/g if $product;
	next if $line =~ /\$PRODUCT/;
	$line =~ s/\$FIRMWARE/$firmware/g if $firmware;
	next if $line =~ /\$FIRMWARE/;
	my $linetype;
	if ($line =~ /^(\S*)LINE\s+(.*?)$/) {
	    $linetype = $1;
	    $line = $2;
	}
	next if !$line;
	if (!$linetype ||
	    ($linetype eq "USB" && ($port =~ /usb/i || $vendor)) ||
	    ($linetype eq "PARPORT" && !$vendor &&
	     $port =~ /(parport|pt_drv|parallel)/i) ||
	    ($linetype eq "SCSI" && !$vendor &&
	     $port =~ m!(/sg|scsi|/scanner)!i)) {
	    handle_configs::set_directive(\@driverconf, $line, 1);
	} elsif ($linetype eq "FIRMWARE" && $firmware) {
	    handle_configs::set_directive(\@driverconf, $line, 0);
	}
    }
    output("$sanedir/$a.conf", @driverconf);
    add2dll($a);
}

sub add2dll {
    return if member($_[0], chomp_(cat_("$sanedir/dll.conf")));
    my @dllconf = cat_("$sanedir/dll.conf");
    handle_configs::add_directive(\@dllconf, $_[0]);
    output("$sanedir/dll.conf", @dllconf);
}

sub setfirmware {
    my ($backend, $firmwareline) = @_;
    my @driverconf = cat_("$sanedir/$backend.conf");
    handle_configs::set_directive(\@driverconf, $firmwareline, 0);
    output("$sanedir/$backend.conf", @driverconf);
}

sub installfirmware {
    # Install the firmware file in /usr/share/sane/firmware
    my ($firmware, $backend) = @_;
    return "" if !$firmware;
    # Install firmware
    run_program::rooted($::prefix, "mkdir", "-p",
			"/usr/share/sane/firmware") || do {
			    $in->ask_warn(N("Error"),
					  N("Could not create directory /usr/share/sane/firmware!"));
			    return "";
			};
    # Link /usr/share/sane/firmware to /usr/share/sane/<backend name> as
    # some backends ignore the supplied absolute path to the firmware file
    # and always search their own directory
    if ($backend) {
	run_program::rooted($::prefix, "ln", "-sf",
			    "/usr/share/sane/firmware",
			    "/usr/share/sane/$backend") || do {
				$in->ask_warn(N("Error"),
					      N("Could not create link /usr/share/sane/%s!", $backend));
				return "";
			    };
    }
    run_program::rooted($::prefix, "cp", "-f", "$firmware",
			"/usr/share/sane/firmware") || do {
			    $in->ask_warn(N("Error"),
					  N("Could not copy firmware file %s to /usr/share/sane/firmware!", $firmware));
			    return "";
			};
    $firmware =~ s!^(.*)(/[^/]+)$!/usr/share/sane/firmware$2!;
    run_program::rooted($::prefix, "chmod", "644",
			$firmware) || do {
			    $in->ask_warn(N("Error"),
					  N("Could not set permissions of firmware file %s!", $firmware));
			    return "";
			};
    return $firmware;
}

sub configured() {
    my @res;
    my $parportscannerfound = 0;
    # Run "scanimage -L", to find the scanners which are already working
    local *LIST;
    open LIST, "LC_ALL=C scanimage -L |";
    while (my $line = <LIST>) {
	if ($line =~ /^\s*device\s*`([^`']+)'\s+is\s+a\s+(\S.*)$/) {
	    # Extract port and description
	    my $port = $1;
	    my $description = $2;
	    # Remove duplicate scanners appearing through saned and the
	    # "net" backend
	    next if $port =~ /^net:(localhost|127.0.0.1):/;
	    # Is the scanner hooked to a parallel or serial port?
	    if ($port =~ /(parport|pt_drv|parallel|ttys)/i) {
		$parportscannerfound = 1;
	    }
	    # Determine which SANE backend the scanner in question uses
	    $port =~ /^([^:]+):/;
	    my $backend = $1;
	    # Does the scanner need a firmware file
	    my $firmwareline = firmwareline($backend);
	    # Store collected data
	    push @res, { 
		port => $port, 
		val => { 
		    DESCRIPTION => $description,
		    ($backend ? (BACKEND => $backend) : ()),
		    ($firmwareline ? 
		     (FIRMWARELINE => $firmwareline) : ()),
		}
	    };
	}
    }
    close LIST;
    # We have a parallel port scanner, make it working for non-root users
    nonroot_access_for_parport($parportscannerfound);
    return @res;
}

sub nonroot_access_for_parport {

    # This function configures a non-root access for parallel port
    # scanners by running saned as root, exporting the scanner to
    # localhost and letting the user's frontend use the "net" backend
    # to access the scanner through the loopback network device.

    # See also
    # http://www.linuxprinting.org/download/digitalimage/Scanning-as-Normal-User-on-Wierd-Scanner-Mini-HOWTO.txt

    # Desired state of this facility: 1: Enable, 0: Disable
    my ($enable) = @_;
    # Is saned running?
    my $sanedrunning = services::starts_on_boot("saned");
    # Is the "net" SANE backend active
    my $netbackendactive = grep { /^\s*net\s*$/ }
      cat_("/etc/sane.d/dll.conf");
    # Set this to 1 to tell the caller that the list of locally available
    # scanners has changed (Here if the SANE client configuration has
    # changed)
    my $changed = 0;
    my $importschanged = 0;
    if ($enable) {
	# Enable non-root access
	
	# Install/start saned
	if (!$sanedrunning) {
	    # Make sure saned and xinetd is installed and 
	    # running
	    if (!files_exist('/usr/sbin/xinetd',
			     '/usr/sbin/saned')) {
		if (!$in->do_pkgs->install('xinetd', 'saned')) {
		    $in->ask_warn(N("Scannerdrake"),
				  N("Could not install the packages needed to share your scanner(s).") . " " .
				  N("Your scanner(s) will not be available for non-root users."));
		}
		return 0;
	    }
	}

	# Modify /etc/xinetd.d/saned to let saned run as root
	my @sanedxinetdconf = cat_("/etc/xinetd.d/saned");
	s/(user\s*=\s*).*$/$1root/ foreach @sanedxinetdconf;
	s/(group\s*=\s*).*$/$1root/ foreach @sanedxinetdconf;
	output("/etc/xinetd.d/saned", @sanedxinetdconf);

	# Read list of hosts to where to export the local scanners
	my @exports = cat_("/etc/sane.d/saned.conf");
	# Read list of hosts from where to import scanners
	my @imports = cat_("/etc/sane.d/net.conf");
	# Add "localhost" to the machines which saned exports
	handle_configs::set_directive(\@exports, "localhost")
	    if !member("localhost\n", @exports);
	# Add "localhost" to the machines which "net" imports
	handle_configs::set_directive(\@imports, "localhost")
	    if !member("localhost\n", @imports);
	# Write /etc/sane.d/saned.conf
	output("/etc/sane.d/saned.conf", @exports);
	# Write /etc/sane.d/net.conf
	output("/etc/sane.d/net.conf", @imports);

	# Make sure that the "net" backend is active
	scanner::add2dll("net");
	
	# (Re)start saned and make sure that it gets started on
	# every boot
	services::start_service_on_boot("saned");
	services::start_service_on_boot("xinetd");
	services::restart("xinetd");

    } else {
	# Disable non-root access

	if (-r "/etc/xinetd.d/saned") {
	    # Modify /etc/xinetd.d/saned to let saned run as saned
	    my @sanedxinetdconf = cat_("/etc/xinetd.d/saned");
	    s/(user\s*=\s*).*$/$1saned/ foreach @sanedxinetdconf;
	    s/(group\s*=\s*).*$/$1saned/ foreach @sanedxinetdconf;
	    output("/etc/xinetd.d/saned", @sanedxinetdconf);
	    # Restart xinetd
	    services::restart("xinetd") if $sanedrunning;
	}
    }

    return 1;
}

sub detect {
    my @configured = @_;
    my @res;
    # Run "sane-find-scanner", this also detects USB scanners which only
    # work with libusb.

    my @devices = detect_devices::probeall();

    local *DETECT;
    open DETECT, "LC_ALL=C sane-find-scanner -q |";
    while (my $line = <DETECT>) {
	my ($vendorid, $productid, $make, $model, $description, $port, $driver);
	if ($line =~ /^\s*found\s+USB\s+scanner/i) {
	    # Found an USB scanner
	    if ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f\[]+[^\[]*\[([^\[\]]+)\].*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f\[]+[^\[]*\[([^\[\]]+)\]/) {
		# Scanner connected via libusb
		$vendorid = $1;
		$make = $2;
		$productid = $4;
		$model = $5;
		$description = "$make|$model";
	    } elsif ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f]+.*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f]+/) {
		# Scanner connected via scanner.o kernel module
		$vendorid = $1;
		$productid = $3;
	    }
	    if ($vendorid && $productid) {
		my ($vendor) = ($vendorid =~ /0x([0-9a-f]+)/);
		my ($id) = ($productid =~ /0x([0-9a-f]+)/);
		my ($device) = grep { sprintf("%04x", $_->{vendor}) eq $vendor && sprintf("%04x", $_->{id}) eq $id } @devices;

		if ($device) {
		    $driver = $device->{driver};
		} else {
		    #warn "Failed to lookup $vendorid and $productid!\n";
		}
                 
		# We have vendor and product ID, look up the scanner in
		# the usbtable
		foreach my $entry (cat_("$scannerDBdir/usbtable")) {
		    if ($entry =~ 
			/^\s*$vendorid\s+$productid\s+.*\"([^\"]+)\"\s*$/) {
			$description = $1;
			$description =~ s/Seiko\s+Epson/Epson/i;
			if ($description =~ /^([^\|]+)\|(.*)$/) {
			    $make = $1;
			    $model = $2;
			}
			last;
		    }
		}
	    }
	} elsif ($line =~ /^\s*found\s+SCSI/i) {
	    # SCSI scanner
	    if ($line =~ /\"([^\"\s]+)\s+([^\"]+?)\s+([^\"\s]+)\"/) {
		$make = $1;
		$model = $2;
		$description = "$make|$model";
	    }
	} else {
	    # Comment line in output of "sane-find-scanner"
	    next;
	}
	# The Alcatel Speed Touch internet scanner is not supported by
	# SANE
	next if $description =~ /Alcatel.*Speed.*Touch|Camera|ISDN|ADSL/i;
	# Extract port
	$port = $1 if $line =~ /\s+(\S+)\s*$/;
	# Check for duplicate (scanner.o/libusb)
	if ($port =~ /^libusb/) {
	    my $duplicate = 0;
	    foreach (@res) {
		if ($_->{val}{vendor} eq $vendorid &&
		    $_->{val}{id} eq $productid &&
		    $_->{port} =~ /dev.*usb.*scanner/ &&
		    !defined($_->{port2})) {
		    # Duplicate entry found, merge the entries
		    $_->{port2} = $port;
		    $_->{val}{MANUFACTURER} ||= $make;
		    $_->{val}{MODEL} ||= $model;
		    $_->{val}{DESCRIPTION} ||= $description;
		    $duplicate = 1;
		    last;
		}
	    }
	    next if $duplicate;
	}
	# Store collected data
	push @res, { 
	    port => $port, 
	    val => { 
		CLASS => 'SCANNER',
		MODEL => $model,
		MANUFACTURER => $make,
		DESCRIPTION => $description,
		id => $productid,
		vendor => $vendorid,
		driver => $driver,
		drakx_device => $device,
	    } 
	};
    }
    close DETECT;
    if (@configured) {
	# Remove scanners which are already working
	foreach my $d (@res) {
	    my $searchport1 =
		handle_configs::searchstr(resolve_symlinks($d->{port}));
	    my $searchport2 =
		handle_configs::searchstr(resolve_symlinks($d->{port2}));
	    foreach my $c (@configured) {
		my $currentport = resolve_symlinks($c->{port});
		if ($currentport =~ /$searchport1$/ ||
		    $searchport2 && $currentport =~ /$searchport2$/) {
		    $d->{configured} = 1;
		    last;
		}
	    }
	}
	@res = grep { ! $_->{configured} } @res;
    }
    # blacklist device that have a driver b/c of buggy sane-find-scanner:
    return grep { member($_->{val}{driver}, qw(scanner unknown)) } @res;
}

sub resolve_symlinks {

    # Check if a given file (either the pure filename or in a SANE device
    # string as "<prefix>:<file>") is a symlink, if so expand the link.
    # If the new file name is a link, expand again, until finding the
    # physical file.
    my ($file) = @_;
    my $prefix = "";
    if ($file =~ m!^([^/]*)(/.*)$!) {
	$prefix = $1;
	$file = $2;
    } else {
	return $file;
    }
    while (1) {
	my $ls = `ls -l $file 2> /dev/null`;
	if ($ls =~ m!\s($file)\s*\->\s*(\S+)\s*$!) {
	    my $target = $2;
	    if ($target !~ m!^/! && $file =~ m!^(.*)/[^/]+$!) {
		$target = "$1/$target";
	    }
	    $file = $target;
	} else {
	    last;
	}
    }
    return $prefix . $file;
}

sub get_usb_ids_for_port {
    my ($port) = @_;
    local *DETECT;
    if ($port =~ /^\s*libusb:(\d+):(\d+)\s*$/) {
	# Use "lsusb" to find the USB IDs
	open DETECT, "LC_ALL=C lsusb -s $1:$2 |";
	while (my $line = <DETECT>) {
	    if ($line =~ /ID\s+([0-9a-f]+):(0x[0-9a-f]+)($|\s+)/) {
		# Scanner connected via scanner.o kernel module
		return "0x$1", "0x$2";
		last;
	    }
	}
    } else {
	# Run "sane-find-scanner" on the port
	open DETECT, "LC_ALL=C sane-find-scanner -q $port |";
	while (my $line = <DETECT>) {
	    if ($line =~ /^\s*found\s+USB\s+scanner/i) {
		if ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f]+.*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f]+/) {
		    # Scanner connected via scanner.o kernel module
		    return $1, $3;
		}
	    }
	}
    }
}

sub readconfiglinetemplates {
    # Read templates for configuration file lines
    my %configlines;
    my $backend;
    foreach my $line (cat_("$scannerDBdir/scannerconfigs")) {
	chomp $line;
	if ($line =~ /^\s*SERVER\s+(\S+)\s*$/) {
	    $backend = $1;
	} elsif ($backend) {
	    push @{$configlines{$backend}}, $line;
	}
    }
    return \%configlines;
}

sub firmwareline {
    # Determine whether the given SANE backend supports a firmware file
    # and return the line needed in the config file
    my ($backend) = @_;
    # Read templates for configuration file lines
    my %configlines = %{readconfiglinetemplates()};
    # Does the backend support a line for the firmware?
    my @firmwarelines = (grep { s/^FIRMWARELINE // } @{$configlines{$backend}});
    return join("\n", @firmwarelines);
}

sub readScannerDB {
    my ($file) = @_;
    my ($card, %cards);

    my $F = common::openFileMaybeCompressed($file);

    my ($lineno, $cmd, $val) = 0;
    my $fs = {
        LINE => sub { push @{$card->{lines}}, "LINE $val" },
        SCSILINE => sub { push @{$card->{lines}}, "SCSILINE $val" },
        USBLINE => sub { push @{$card->{lines}}, "USBLINE $val" },
        PARPORTLINE => sub { push @{$card->{lines}}, "PARPORTLINE $val" },
        FIRMWARELINE => sub { push @{$card->{lines}}, "FIRMWARELINE $val" },
	NAME => sub {
	    #$cards{$card->{type}} = $card if ($card and !$card->{flags}{unsupported});
	    $cards{$card->{type}} = $card if $card;
	    $val =~ s/Seiko\s+Epson/Epson/i;
	    $card = { type => $val };
	},
	SEE => sub {
	    $val =~ s/Seiko\s+Epson/Epson/i;
	    my $c = $cards{$val} or die "Error in database, invalid reference $val at line $lineno";

	    push @{$card->{lines}}, @{$c->{lines} || []};
	    add2hash($card->{flags}, $c->{flags});
	    add2hash($card, $c);
	},
	ASK => sub { $card->{ask} = $val },
	SERVER => sub { $card->{server} = $val },
	DRIVER => sub { $card->{driver} = $val },
	KERNEL => sub { push(@{$card->{kernel}}, $val) },
	SCSIKERNEL => sub { push(@{$card->{scsikernel}}, $val) },
	USBKERNEL => sub { push(@{$card->{usbkernel}}, $val) },
	PARPORTKERNEL => sub { push(@{$card->{parportkernel}}, $val) },
	UNSUPPORTED => sub { $card->{flags}{unsupported} = 1 },
	MANUAL => sub { $card->{flags}{manual} = 1 },
	MANUALREQUIRED => sub { $card->{flags}{manual} = 2 },
	COMMENT => sub {},
    };

    local $_;
    while (<$F>) { $lineno++;
	s/\s+$//;
	/^#/ and next;
	/^$/ and next;
	/^END/ and do { $cards{$card->{type}} = $card if $card; last };
	($cmd, $val) = /(\S+)\s*(.*)/ or next; #log::l("bad line $lineno ($_)"), next;
	my $f = $fs->{$cmd};
	$f ? $f->() : log::l("unknown line $lineno ($_)");
    }
    \%cards;
}

sub updateScannerDBfromUsbtable() {
    substInFile { s/^END// } "ScannerDB";
    my $to_add = "# generated from usbtable by scannerdrake\n";
    foreach (cat_("$ENV{SHARE_PATH}/ldetect-lst/usbtable")) {
	my ($vendor_id, $product_id, $mod, $name) = chomp_(split /\s/,$_,4);
	next if $mod ne '"scanner"';
	$name =~ s/\"(.*)\"$/$1/;
	if (member($name, keys %$scanner::scannerDB)) {
	    print "#[$name] already in ScannerDB!\n";
	    next;
	}
	$to_add .= "NAME $name\nDRIVER USB\nCOMMENT usb $vendor_id $product_id\nUNSUPPORTED\n\n";
    }
    $to_add .= "END\n";

    append_to_file("ScannerDB", $to_add);
}

sub updateScannerDBfromSane {
    my ($sanesrcdir) = @_;
    substInFile { s/^END// } "ScannerDB";

    my $to_add = "# generated from Sane by scannerdrake\n";
    # for compat with our usbtable
    my $sane2DB = { 
		   "Acer" => "Acer Peripherals Inc.",
		   "AGFA" => "AGFA-Gevaert NV",
		   "Agfa" => "AGFA-Gevaert NV",
		   "Epson" => "Epson Corp.",
		   "Fujitsu Computer Products of America" => "Fujitsu",
		   "HP" => sub { $_[0] =~ s/HP\s/Hewlett-Packard|/; $_[0] =~ s/HP4200/Hewlett-Packard|ScanJet 4200C/; $_[0] },
		   "Hewlett-Packard" => sub { $_[0] =~ s/HP 3200 C/Hewlett-Packard|ScanJet 3200C/ or $_[0] = "Hewlett-Packard|$_[0]"; $_[0] },
		   "Hewlett Packard" => "Hewlett-Packard",
		   "Kodak" => "Kodak Co.",
		   "Mustek" => "Mustek Systems Inc.",
		   "NEC" => "NEC Systems",
		   "Nikon" => "Nikon Corp.",
		   "Plustek" => "Plustek, Inc.",
		   "Primax" => "Primax Electronics",
		   "Siemens" => "Siemens Information and Communication Products",
		   "Trust" => "Trust Technologies",
		   "UMAX" => "Umax",
		   "Vobis/Highscreen" => "Vobis",
		  };

    # Read templates for configuration file lines
    my %configlines = %{readconfiglinetemplates()};

    foreach my $ff (glob_("$sanesrcdir/doc/descriptions/*.desc"), glob_("$sanesrcdir/doc/descriptions-external/*.desc"), "UNSUPPORTED") {
	my $f = $ff;
	# unsupported.desc must be treated separately, as the list of
	# unsupported scanners in SANE is out of date.
	next if $f =~ /unsupported.desc$/;
	# Treat unsupported.desc in the end
	$f = "$sanesrcdir/doc/descriptions/unsupported.desc" if
	    ($f eq "UNSUPPORTED");
	my $F = common::openFileMaybeCompressed($f);
	$to_add .= "\n# from $f";
	my ($lineno, $cmd, $val) = 0;
	my ($name, $intf, $comment, $mfg, $backend);
	my $fs = {
		  backend => sub { $backend = $val },
		  mfg => sub { $mfg = $val; $name = undef },#bug when a new mfg comes. should called $fs->{ $name }(); but ??
		  model => sub {
		      unless ($name) { $name = $val; return }
		      $name = member($mfg, keys %$sane2DB) ?
			ref($sane2DB->{$mfg}) ? $sane2DB->{$mfg}($name) : "$sane2DB->{ $mfg }|$name" : "$mfg|$name";
		      # When adding the unsupported scanner models, check
		      # whether the model is not already supported. To
		      # compare the names ignore upper/lower case.
		      my $searchname = quotemeta($name);
		      if (($backend =~ /unsupported/i) &&
			  ($to_add =~ /^NAME $searchname$/im)) {
			  $to_add .= "# $name already supported!\n";
		      } else {
			  # SANE bug: "snapscan" calls itself "SnapScan"
			  $backend =~ s/SnapScan/snapscan/g;
			  $to_add .= "\nNAME $name\nSERVER $backend\nDRIVER $intf\n";
			  # Go through the configuration lines of
			  # this backend and add what is needed for the
			  # interfaces of this scanner
			  foreach my $line (@{$configlines{$backend}}) {
			      my $i = $1 if $line =~ /^\s*(\S*?)LINE/;
			      if (!$i || $i eq "FIRMWARE" || 
				  $intf =~ /$i/i) {
				  $to_add .= "$line\n";
			      }
			  }
			  if ($backend =~
			      /(unsupported|mustek_pp|gphoto2)/i) {
			      $to_add .= "UNSUPPORTED\n";
			  }
			  $to_add .= "COMMENT $comment\n" if $comment;
			  $comment = undef; 
		      }
		      $name = $val;
		  },
		  interface => sub { $intf = $val },
		  comment => sub { $comment = $val },
		 };
	local $_;
	while (<$F>) { $lineno++;
		       s/\s+$//;
		       /^;/ and next;
		       ($cmd, $val) = /:(\S+)\s*\"([^;]*)\"/ or next; #log::l("bad line $lineno ($_)"), next;
		       my $f = $fs->{$cmd};
		       $f ? $f->() : log::l("unknown line $lineno ($_)");
		   }
	$fs->{model}(); # the last one
    }
    $to_add .= "\nEND\n";
    append_to_file("ScannerDB", $to_add);
}

1; #
id='n3175' href='#n3175'>3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371
package urpm;

use strict;
use vars qw($VERSION @ISA @EXPORT);

$VERSION = '4.4';
@ISA = qw(Exporter URPM);
@EXPORT = qw(N);

use URPM;
use URPM::Resolve;
use POSIX;
use Locale::gettext();

#- I18N.
setlocale(LC_ALL, "");
Locale::gettext::textdomain("urpmi");

sub N {
    my ($format, @params) = @_;
    sprintf(Locale::gettext::gettext($format || ''), @params);
}

#- tool functions.
sub basename { local $_ = shift; s|/*\s*$||; s|.*/||; $_ }

#- create a new urpm object.
sub new {
    my ($class) = @_;
    bless {
	   config     => "/etc/urpmi/urpmi.cfg",
	   skiplist   => "/etc/urpmi/skip.list",
	   instlist   => "/etc/urpmi/inst.list",
	   statedir   => "/var/lib/urpmi",
	   cachedir   => "/var/cache/urpmi",
	   media      => undef,

	   provides   => {},
	   depslist   => [],

	   sync       => \&sync_webfetch, #- first argument is directory, others are url to fetch.
	   proxy      => get_proxy(),
	   options    => {},

	   fatal      => sub { printf STDERR "%s\n", $_[1]; exit($_[0]) },
	   error      => sub { printf STDERR "%s\n", $_[0] },
	   log        => sub { printf STDERR "%s\n", $_[0] },
	  }, $class;
}

sub get_proxy {
    my $proxy = {
		 http_proxy => undef ,
		 ftp_proxy => undef ,
		 user => undef,
		 pwd => undef
		};
    local (*F, $_);
    open F, "/etc/urpmi/proxy.cfg" or return undef;
    while (<F>) {
	chomp; s/#.*$//; s/^\s*//; s/\s*$//;
	/^http_proxy\s*=\s*(.*)$/ and $proxy->{http_proxy} = $1, next;
	/^ftp_proxy\s*=\s*(.*)$/ and $proxy->{ftp_proxy} = $1, next;
	/^proxy_user\s*=\s*(.*):(.*)$/ and do {
	    $proxy->{user} = $1;
	    $proxy->{pwd} = $2;
	    next;
	};
	next;
    }
    close F;
    $proxy;
}

sub set_proxy {
    my $proxy = shift @_;
    my @res;
    if (defined $proxy->{proxy}{http_proxy} or defined $proxy->{proxy}{ftp_proxy}) {
	for ($proxy->{type}) {
	    /wget/ && do {
		for ($proxy->{proxy}) {
		    if (defined $_->{http_proxy}) {
			$ENV{http_proxy} = $_->{http_proxy} =~ /^http:/ ? $_->{http_proxy} : "http://$_->{http_proxy}";
		    }
		    $ENV{ftp_proxy} = $_->{ftp_proxy} if defined $_->{ftp_proxy};
		    @res = ("--proxy-user=$_->{user}", "--proxy-passwd=$_->{pwd}") if defined $_->{user} && defined $_->{pwd};
		}
		last;
	    };
	    /curl/ && do {
		for ($proxy->{proxy}) {
		    push @res, ('-x', $_->{http_proxy}) if defined $_->{http_proxy};
		    push @res, ('-x', $_->{ftp_proxy}) if defined $_->{ftp_proxy};
		    push @res, ('-U', "$_->{user}:$_->{pwd}") if defined $_->{user} && defined $_->{pwd};
		}
		last;
	    };
	    die N("Unknown webfetch `%s' !!!\n", $proxy->{type});
	}
    }
    return @res;
}

#- quoting/unquoting a string that may be containing space chars.
sub quotespace { local $_ = $_[0] || ''; s/(\s)/\\$1/g; $_ }
sub unquotespace { local $_ = $_[0] || ''; s/\\(\s)/$1/g; $_ }

#- syncing algorithms, currently is implemented wget and curl methods,
#- webfetch is trying to find the best (and one which will work :-)
sub sync_webfetch {
    my $options = shift @_;
    my %files;
    #- extract files according to protocol supported.
    #- currently ftp and http protocol are managed by curl or wget,
    #- ssh and rsync protocol are managed by rsync *AND* ssh.
    foreach (@_) {
	/^([^:_]*)[^:]*:/ or die N("unknown protocol defined for %s", $_);
	push @{$files{$1}}, $_;
    }
    if ($files{removable} || $files{file}) {
	sync_file($options, @{$files{removable} || []}, @{$files{file} || []});
	delete @files{qw(removable file)};
    }
    if ($files{ftp} || $files{http} || $files{https}) {
	if (-x "/usr/bin/curl" && (! ref($options) || $options->{prefer} ne 'wget' || ! -x "/usr/bin/wget")) {
	    sync_curl($options, @{$files{ftp} || []}, @{$files{http} || []}, @{$files{https} || []});
	} elsif (-x "/usr/bin/wget") {
	    sync_wget($options, @{$files{ftp} || []}, @{$files{http} || []}, @{$files{https} || []});
	} else {
	    die N("no webfetch (curl or wget currently) found\n");
	}
	delete @files{qw(ftp http https)};
    }
    if ($files{rsync}) {
	sync_rsync($options, @{$files{rsync} || []});
	delete $files{rsync};
    }
    if ($files{ssh}) {
	my @ssh_files;
	foreach (@{$files{ssh} || []}) {
	    /^ssh:\/\/([^\/]*)(.*)/ and push @ssh_files, "$1:$2";
	}
	sync_ssh($options, @ssh_files);
	delete $files{ssh};
    }
    %files and die N("unable to handle protocol: %s", join ', ', keys %files);
}
sub propagate_sync_callback {
    my $options = shift @_;
    if (ref($options) && $options->{callback}) {
	my $mode = shift @_;
	if ($mode =~ /^(start|progress|end)$/) {
	    my $file = shift @_;
	    $file =~ s|([^:]*://[^/:\@]*:)[^/:\@]*(\@.*)|$1xxxx$2|; #- if needed...
	    $options->{callback}($mode, $file, @_);
	} else {
	    $options->{callback}($mode, @_);
	}
    }
}
sub sync_file {
    my $options = shift @_;
    foreach (@_) {
	my ($in) = /^(?:removable[^:]*|file):\/(.*)/;
	propagate_sync_callback($options, 'start', $_);
	system("cp", "--preserve=mode", "--preserve=timestamps", "-R", $in || $_, ref($options) ? $options->{dir} : $options) and
	  die N("copy failed: %s", $@);
	propagate_sync_callback($options, 'end', $_);
    }
}
sub sync_wget {
    -x "/usr/bin/wget" or die N("wget is missing\n");
    local *WGET;
    my $options = shift @_;
    #- force download to be done in cachedir to avoid polluting cwd.
    my $cwd = `pwd`; chomp $cwd;
    chdir(ref($options) ? $options->{dir} : $options);
    my ($buf, $total, $file) = ('', undef, undef);
    open WGET, join(" ", map { "'$_'" } "/usr/bin/wget",
		    (ref($options) && $options->{limit_rate} ? "--limit-rate=$options->{limit_rate}" : ()),
		    (ref($options) && $options->{proxy} ? set_proxy({ type => "wget", proxy => $options->{proxy} }) : ()),
		    (ref($options) && $options->{callback} ? ("--progress=bar:force", "-o", "-") :
		     ref($options) && $options->{quiet} ? "-q" : @{[]}),
		    "--retr-symlinks", "-NP",
		    (ref($options) ? $options->{dir} : $options), @_) . " |";
    local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!).
    while (<WGET>) {
	$buf .= $_;
	if ($_ eq "\r" || $_ eq "\n") {
	    if (ref($options) && $options->{callback}) {
		if ($buf =~ /^--\d\d:\d\d:\d\d--\s+(\S.*)\n/ms) {
		    $file && $file ne $1 and propagate_sync_callback($options, 'end', $file);
		    ! defined $file and propagate_sync_callback($options, 'start', $file = $1);
		} elsif (defined $file && ! defined $total && $buf =~ /==>\s+RETR/) {
		    $total = '';
		} elsif (defined $total && $total eq '' && $buf =~ /^[^:]*:\s+(\d\S*)/) {
		    $total = $1;
		} elsif (my ($percent, $speed, $eta) = $buf =~ /^\s*(\d+)%.*\s+(\S+)\s+ETA\s+(\S+)\s*[\r\n]$/ms) {
		    propagate_sync_callback($options, 'progress', $file, $percent, $total, $eta, $speed);
		    if ($_ eq "\n") {
			propagate_sync_callback($options, 'end', $file);
			($total, $file) = (undef, undef);
		    }
		}
	    } else {
		ref($options) && $options->{quiet} or print STDERR $buf;
	    }
	    $buf = '';
	}
    }
    $file and propagate_sync_callback($options, 'end', $file);
    chdir $cwd;
    close WGET or die N("wget failed: exited with %d or signal %d\n", $? >> 8, $? & 127);
}
sub sync_curl {
    -x "/usr/bin/curl" or die N("curl is missing\n");
    local *CURL;
    my $options = shift @_;
    #- force download to be done in cachedir to avoid polluting cwd,
    #- howerver for curl, this is mandatory.
    my $cwd = `pwd`; chomp $cwd;
    chdir(ref($options) ? $options->{dir} : $options);
    my (@ftp_files, @other_files);
    foreach (@_) {
	/^ftp:\/\/.*\/([^\/]*)$/ && -s $1 > 8192 and do { push @ftp_files, $_; next }; #- manage time stamp for large file only.
	push @other_files, $_;
    }
    if (@ftp_files) {
	my ($cur_ftp_file, %ftp_files_info);

	eval { require Date::Manip };

	#- prepare to get back size and time stamp of each file.
	open CURL, join(" ", map { "'$_'" } "/usr/bin/curl",
			(ref($options) && $options->{limit_rate} ? ("--limit-rate", $options->{limit_rate}) : ()),
			(ref($options) && $options->{proxy} ? set_proxy({ type => "curl", proxy => $options->{proxy} }) : ()),
			"--stderr", "-", "-s", "-I", @ftp_files) . " |";
	while (<CURL>) {
	    if (/Content-Length:\s*(\d+)/) {
		!$cur_ftp_file || exists($ftp_files_info{$cur_ftp_file}{size}) and $cur_ftp_file = shift @ftp_files;
		$ftp_files_info{$cur_ftp_file}{size} = $1;
	    }
	    if (/Last-Modified:\s*(.*)/) {
		!$cur_ftp_file || exists($ftp_files_info{$cur_ftp_file}{time}) and $cur_ftp_file = shift @ftp_files;
		eval {
		    $ftp_files_info{$cur_ftp_file}{time} = Date::Manip::ParseDate($1);
		    $ftp_files_info{$cur_ftp_file}{time} =~ s/(\d{6}).{4}(.*)/$1$2/; #- remove day and hour.
		};
	    }
	}
	close CURL;

	#- now analyse size and time stamp according to what already exists here.
	if (@ftp_files) {
	    #- re-insert back shifted element of ftp_files, because curl output above
	    #- have not been parsed correctly, in doubt download them all.
	    push @ftp_files, keys %ftp_files_info;
	} else {
	    #- for that, it should be clear ftp_files is empty... else a above work is
	    #- use less.
	    foreach (keys %ftp_files_info) {
		my ($lfile) = /\/([^\/]*)$/ or next; #- strange if we can't parse it correctly.
		my $ltime = eval { Date::Manip::ParseDate(scalar gmtime((stat $1)[9])) };
		$ltime =~ s/(\d{6}).{4}(.*)/$1$2/; #- remove day and hour.
		-s $lfile == $ftp_files_info{$_}{size} && $ftp_files_info{$_}{time} eq $ltime or
		  push @ftp_files, $_;
	    }
	}
    }
    #- http files (and other files) are correctly managed by curl to conditionnal download.
    #- options for ftp files, -R (-O <file>)*
    #- options for http files, -R (-z file -O <file>)*
    if (my @all_files = ((map { ("-O", $_) } @ftp_files), (map { /\/([^\/]*)$/ ? ("-z", $1, "-O", $_) : @{[]} } @other_files))) {
	my @l = (@ftp_files, @other_files);
	my ($buf, $file) = ('', undef);
	open CURL, join(" ", map { "'$_'" } "/usr/bin/curl",
			(ref($options) && $options->{limit_rate} ? ("--limit-rate", $options->{limit_rate}) : ()),
			(ref($options) && $options->{proxy} ? set_proxy({ type => "curl", proxy => $options->{proxy} }) : ()),
			(ref($options) && $options->{quiet} && !$options->{verbose} ? "-s" : @{[]}),
			"-k", `curl -h` =~ /location-trusted/ ? "--location-trusted" : @{[]},
                        "-R", "-f", "--stderr", "-",
			@all_files) . " |";
	local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!).
	while (<CURL>) {
	    $buf .= $_;
	    if ($_ eq "\r" || $_ eq "\n") {
		if (ref($options) && $options->{callback}) {
		    unless (defined $file) {
			$file = shift @l;
			propagate_sync_callback($options, 'start', $file);
		    }
		    if (my ($percent, $total, $eta, $speed) = $buf =~ /^\s*(\d+)\s+(\S+)[^\r\n]*\s+(\S+)\s+(\S+)[\r\n]$/ms) {
			propagate_sync_callback($options, 'progress', $file, $percent, $total, $eta, $speed);
			if ($_ eq "\n") {
			    propagate_sync_callback($options, 'end', $file);
			    $file = undef;
			}
		    }
		} else {
		    ref($options) && $options->{quiet} or print STDERR $buf;
		}
		$buf = '';
	    }
	}
	chdir $cwd;
	close CURL or die N("curl failed: exited with %d or signal %d\n", $? >> 8, $? & 127);
    } else {
	chdir $cwd;
    }
}
sub sync_rsync {
    -x "/usr/bin/rsync" or die N("rsync is missing\n");
    my $options = shift @_;
    #- force download to be done in cachedir to avoid polluting cwd.
    my $cwd = `pwd`; chomp $cwd;
    chdir(ref($options) ? $options->{dir} : $options);
    my $limit_rate = ref($options) && $options->{limit_rate};
    for ($limit_rate) {
	/^(\d+)$/     and $limit_rate = int $1/1024;
	/^(\d+)[kK]$/ and $limit_rate = $1;
	/^(\d+)[mM]$/ and $limit_rate = 1024*$1;
	/^(\d+)[gG]$/ and $limit_rate = 1024*1024*$1;
    }
    foreach (@_) {
	my $count = 10; #- retry count on error (if file exists).
	my $basename = basename($_);
	my ($file) = /^rsync:\/\/(.*)/ or next;	$file =~ /::/ or $file = $_;
	propagate_sync_callback($options, 'start', $file);
	do {
	    local (*RSYNC, $_);
	    my $buf = '';
	    open RSYNC, join(" ", map { "'$_'" } "/usr/bin/rsync",
			     ($limit_rate ? "--bwlimit=$limit_rate" : ()),
			     (ref($options) && $options->{quiet} ? qw(-q) : qw(--progress -v)),
			     (ref($options) && $options->{compress} ? qw(-z) : ()),
			     qw(--partial --no-whole-file), $file, (ref($options) ? $options->{dir} : $options)) . " |";
	    local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!).
	    while (<RSYNC>) {
		$buf .= $_;
		if ($_ eq "\r" || $_ eq "\n") {
		    if (ref($options) && $options->{callback}) {
			if (my ($percent, $speed) = $buf =~ /^\s*\d+\s+(\d+)%\s+(\S+)\s+/) {
			    propagate_sync_callback($options, 'progress', $file, $percent, undef, undef, $speed);
			}
		    } else {
			ref($options) && $options->{quiet} or print STDERR $buf;
		    }
		    $buf = '';
		}
	    }
	    close RSYNC;
	} while ($? != 0 && --$count > 0 && -e (ref($options) ? $options->{dir} : $options) . "/$basename");
	propagate_sync_callback($options, 'end', $file);
    }
    chdir $cwd;
    $? == 0 or die N("rsync failed: exited with %d or signal %d\n", $? >> 8, $? & 127);
}
sub sync_ssh {
    -x "/usr/bin/rsync" or die N("rsync is missing\n");
    -x "/usr/bin/ssh" or die N("ssh is missing\n");
    my $options = shift @_;
    #- force download to be done in cachedir to avoid polluting cwd.
    my $cwd = `pwd`; chomp $cwd;
    chdir(ref($options) ? $options->{dir} : $options);
    my $limit_rate = ref($options) && $options->{limit_rate};
    for ($limit_rate) {
	/^(\d+)$/     and $limit_rate = int $1/1024;
	/^(\d+)[kK]$/ and $limit_rate = $1;
	/^(\d+)[mM]$/ and $limit_rate = 1024*$1;
	/^(\d+)[gG]$/ and $limit_rate = 1024*1024*$1;
    }
    foreach my $file (@_) {
	my $count = 10; #- retry count on error (if file exists).
	my $basename = basename($file);
	propagate_sync_callback($options, 'start', $file);
	do {
	    local (*RSYNC, $_);
	    my $buf = '';
	    open RSYNC, join(" ", map { "'$_'" } "/usr/bin/rsync",
			     ($limit_rate ? "--bwlimit=$limit_rate" : ()),
			     (ref($options) && $options->{quiet} ? qw(-q) : qw(--progress -v)),
			     (ref($options) && $options->{compress} ? qw(-z) : ()),
			     qw(--partial -e ssh), $file, (ref($options) ? $options->{dir} : $options)) . " |";
	    local $/ = \1; #- read input by only one char, this is slow but very nice (and it works!).
	    while (<RSYNC>) {
		$buf .= $_;
		if ($_ eq "\r" || $_ eq "\n") {
		    if (ref($options) && $options->{callback}) {
			if (my ($percent, $speed) = $buf =~ /^\s*\d+\s+(\d+)%\s+(\S+)\s+/) {
			    propagate_sync_callback($options, 'progress', $file, $percent, undef, undef, $speed);
			}
		    } else {
			ref($options) && $options->{quiet} or print STDERR $buf;
		    }
		    $buf = '';
		}
	    }
	    close RSYNC;
	} while ($? != 0 && --$count > 0 && -e (ref($options) ? $options->{dir} : $options) . "/$basename");
	propagate_sync_callback($options, 'end', $file);
    }
    chdir $cwd;
    $? == 0 or die N("rsync failed: exited with %d or signal %d\n", $? >> 8, $? & 127);
}
#- default logger suitable for sync operation on STDERR only.
sub sync_logger {
    my ($mode, $file, $percent, $total, $eta, $speed) = @_;
    if ($mode eq 'start') {
	print STDERR "    $file\n";
    } elsif ($mode eq 'progress') {
	my $text;
	if (defined $total && defined $eta) {
	    $text = N("        %s%% of %s completed, ETA = %s, speed = %s", $percent, $total, $eta, $speed);
	} else {
	    $text = N("        %s%% completed, speed = %s", $percent, $speed);
	}
	print STDERR $text, " " x (79 - length($text)), "\r";
    } elsif ($mode eq 'end') {
	print STDERR " " x 79, "\r";
    }
}

#- read /etc/urpmi/urpmi.cfg as config file, keep compability with older
#- configuration file by examining if one entry is of the form
#-   <name> <url> {
#-      ...
#-   }
#- else only this form is used
#-   <name> <url>
#-   <name> <ftp_url> with <relative_path_hdlist>
sub read_config {
    my ($urpm, %options) = @_;

    #- keep in mind if it has been called before.
    $urpm->{media} and return; $urpm->{media} ||= [];

    #- check urpmi.cfg content, if the file is old keep track
    #- of old format used.
    local (*F, $_);
    open F, $urpm->{config}; #- no filename can be allowed on some case
    while (<F>) {
	chomp; s/#.*$//; s/^\s*//; s/\s*$//;
	$_ eq '{' and do { #- urpmi.cfg global options extension
	    while (<F>) {
		chomp; s/#.*$//; s/^\s*//; s/\s*$//;
		$_ eq '}' and last;
		#- check for boolean variables first, and after that valued variables.
		my ($no, $k, $v);
		if (($no, $k, $v) = /^(no-)?(verify-rpm|fuzzy|allow-(?:force|nodeps)|(?:pre|post)-clean|excludedocs|compress)(?:\s*:\s*(.*))?$/) {
		    unless (exists($urpm->{options}{$k})) {
			$urpm->{options}{$k} = $v eq '' || $v =~ /^(yes|on|1)$/i || 0;
			$no and $urpm->{options}{$k} = ! $urpm->{options}{$k} || 0;
		    }
		    next;
		} elsif (($k, $v) = /^(limit-rate|excludepath|key[\-_]ids|split-(?:level|length))\s*:\s*(.*)$/) {
		    unless (exists($urpm->{options}{$k})) {
			$v =~ /^'([^']*)'$/ and $v = $1; $v =~ /^"([^"]*)"$/ and $v = $1;
			$urpm->{options}{$k} = $v;
		    }
		    next;
		}
		$_ and $urpm->{error}(N("syntax error in config file at line %s", $.));
	    }
	    exists $urpm->{options}{key_ids} && ! exists $urpm->{options}{'key-ids'} and
	      $urpm->{options}{'key-ids'} = delete $urpm->{options}{key_ids};
	    next };
	/^(.*?[^\\])\s+(?:(.*?[^\\])\s+)?{$/ and do { #- urpmi.cfg format extention
	    my $medium = { name => unquotespace($1), clear_url => unquotespace($2) };
	    while (<F>) {
		chomp; s/#.*$//; s/^\s*//; s/\s*$//;
		$_ eq '}' and last;
		/^(hdlist|list|with_hdlist|removable|md5sum|key[\-_]ids)\s*:\s*(.*)$/ and $medium->{$1} = $2, next;
		/^(update|ignore|synthesis|virtual)\s*$/ and $medium->{$1} = 1, next;
		/^modified\s*$/ and next;
		$_ and $urpm->{error}(N("syntax error in config file at line %s", $.));
	    }
	    exists $medium->{key_ids} && ! exists $medium->{'key-ids'} and $medium->{'key-ids'} = delete $medium->{key_ids};
	    $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium;
	    next };
	/^(.*?[^\\])\s+(.*?[^\\])\s+with\s+(.*)$/ and do { #- urpmi.cfg old format for ftp
	    my $medium = { name => unquotespace($1), clear_url => unquotespace($2), with_hdlist => unquotespace($3) };
	    $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium;
	    next };
	/^(.*?[^\\])\s+(?:(.*?[^\\])\s*)?$/ and do { #- urpmi.cfg old format (assume hdlist.<name>.cz2?)
	    my $medium = { name => unquotespace($1), clear_url => unquotespace($2) };
	    $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium;
	    next };
	$_ and $urpm->{error}(N("syntax error in config file at line %s", $.));
    }
    close F;

    #- keep in mind when an hdlist/list file is used, really usefull for
    #- the next probe.
    my (%hdlists, %lists);
    foreach (@{$urpm->{media}}) {
	if ($_->{hdlist}) {
	    exists($hdlists{$_->{hdlist}}) and
	      $_->{ignore} = 1,
		$urpm->{error}(N("medium \"%s\" trying to use an already used hdlist, medium ignored", $_->{name}));
	    $hdlists{$_->{hdlist}} = undef;
	}
	if ($_->{list}) {
	    exists($lists{$_->{list}}) and
	      $_->{ignore} = 1,
		$urpm->{error}(N("medium \"%s\" trying to use an already used list, medium ignored", $_->{name}));
	    $lists{$_->{list}} = undef;
	}
    }

    #- urpmi.cfg if old is not enough to known the various media, track
    #- directly into /var/lib/urpmi,
    foreach (glob("$urpm->{statedir}/hdlist.*")) {
	if (/\/hdlist\.((.*)\.cz2?)$/) {
	    #- check if it has already been detected above.
	    exists($hdlists{"hdlist.$1"}) and next;

	    #- if not this is a new media to take care if
	    #- there is a list file.
	    if (-s "$urpm->{statedir}/list.$2") {
		if (exists($lists{"list.$2"})) {
		    $urpm->{error}(N("unable to take care of medium \"%s\" as list file is already used by another medium", $2));
		} else {
		    my $medium;
		    foreach (@{$urpm->{media}}) {
			$_->{name} eq $2 and $medium = $_, last;
		    }
		    $medium and $urpm->{error}(N("unable to use name \"%s\" for unnamed medium because it is already used",
						 $2)), next;

		    $medium = { name => $2, hdlist => "hdlist.$1", list => "list.$2" };
		    $urpm->probe_medium($medium, %options) and push @{$urpm->{media}}, $medium;
		}
	    } else {
		$urpm->{error}(N("unable to take medium \"%s\" into account as no list file [%s] exists",
				 $2, "$urpm->{statedir}/list.$2"));
	    }
	} else {
	    $urpm->{error}(N("unable to determine medium of this hdlist file [%s]", $_));
	}
    }

    #- check the presence of hdlist file and list file if necessary.
    unless ($options{nocheck_access}) {
	foreach (@{$urpm->{media}}) {
	    $_->{ignore} and next;
	    -r "$urpm->{statedir}/$_->{hdlist}" || -r "$urpm->{statedir}/synthesis.$_->{hdlist}" && $_->{synthesis} or
	      $_->{ignore} = 1, $urpm->{error}(N("unable to access hdlist file of \"%s\", medium ignored", $_->{name}));
	    $_->{list} && -r "$urpm->{statedir}/$_->{list}" || defined $_->{url} or
	      $_->{ignore} = 1, $urpm->{error}(N("unable to access list file of \"%s\", medium ignored", $_->{name}));
	}
    }

    local *MD5SUM;
    open MD5SUM, "$urpm->{statedir}/MD5SUM";
    while (<MD5SUM>) {
	my ($md5sum, $file) = /(\S*)\s+(.*)/;
	foreach (@{$urpm->{media}}) {
	    ($_->{synthesis} && "synthesis.").$_->{hdlist} eq $file and $_->{md5sum} = $md5sum, last;
	}
    }
    close MD5SUM;
}

#- probe medium to be used, take old medium into account too.
sub probe_medium {
    my ($urpm, $medium, %options) = @_;
    local $_;

    my $existing_medium;
    foreach (@{$urpm->{media}}) {
	$_->{name} eq $medium->{name} and $existing_medium = $_, last;
    }
    $existing_medium and $urpm->{error}(N("trying to bypass existing medium \"%s\", avoiding", $medium->{name})), return;
    
    $medium->{url} ||= $medium->{clear_url};

    if ($medium->{virtual}) {
	#- a virtual medium need to have an url available without using a list file.
	if ($medium->{hdlist} || $medium->{list}) {
	    $medium->{ignore} = 1;
	    $urpm->{error}(N("virtual medium \"%s\" should not have defined hdlist or list file, medium ignored",
			     $medium->{name}));
	}
	unless ($medium->{url}) {
	    $medium->{ignore} = 1;
	    $urpm->{error}(N("virtual medium \"%s\" should have a clear url, medium ignored",
			     $medium->{name}));
	}
    } else {
	unless ($medium->{ignore} || $medium->{hdlist}) {
	    $medium->{hdlist} = "hdlist.$medium->{name}.cz";
	    -e "$urpm->{statedir}/$medium->{hdlist}" or $medium->{hdlist} = "hdlist.$medium->{name}.cz2";
	    -e "$urpm->{statedir}/$medium->{hdlist}" or
	      $medium->{ignore} = 1,
		$urpm->{error}(N("unable to find hdlist file for \"%s\", medium ignored", $medium->{name}));
	}
	unless ($medium->{ignore} || $medium->{list}) {
	    unless (defined $medium->{url}) {
		$medium->{list} = "list.$medium->{name}";
		unless (-e "$urpm->{statedir}/$medium->{list}") {
		    $medium->{ignore} = 1,
		      $urpm->{error}(N("unable to find list file for \"%s\", medium ignored", $medium->{name}));
		}
	    }
	}

	#- there is a little more to do at this point as url is not known, inspect directly list file for it.
	unless ($medium->{url}) {
	    my %probe;
	    if (-r "$urpm->{statedir}/$medium->{list}") {
		local *L;
		open L, "$urpm->{statedir}/$medium->{list}";
		while (<L>) {
		    #- /./ is end of url marker in list file (typically generated by a
		    #- find . -name "*.rpm" > list
		    #- for exportable list file.
		    /^(.*)\/\.\// and $probe{$1} = undef;
		    /^(.*)\/[^\/]*$/ and $probe{$1} = undef;
		}
		close L;
	    }
	    foreach (sort { length($a) <=> length($b) } keys %probe) {
		if ($medium->{url}) {
		    $medium->{url} eq substr($_, 0, length($medium->{url})) or
		      $medium->{ignore} || $urpm->{error}(N("incoherent list file for \"%s\", medium ignored", $medium->{name})),
			$medium->{ignore} = 1, last;
		} else {
		    $medium->{url} = $_;
		}
	    }
	    unless ($options{nocheck_access}) {
		$medium->{url} or
		  $medium->{ignore} || $urpm->{error}(N("unable to inspect list file for \"%s\", medium ignored",
							$medium->{name})),
							  $medium->{ignore} = 1;
	    }
	}
    }

    #- probe removable device.
    $urpm->probe_removable_device($medium);

    #- clear URLs for trailing /es.
    $medium->{url} and $medium->{url} =~ s|(.*?)/*$|$1|;
    $medium->{clear_url} and $medium->{clear_url} =~ s|(.*?)/*$|$1|;

    $medium;
}

#- probe device associated with a removable device.
sub probe_removable_device {
    my ($urpm, $medium) = @_;

    if ($medium->{url} && $medium->{url} =~ /^removable_?([^_:]*)(?:_[^:]*)?:/) {
	$medium->{removable} ||= $1 && "/dev/$1";
    } else {
	delete $medium->{removable};
    }

    #- try to find device to open/close for removable medium.
    if (exists($medium->{removable})) {
	if (my ($dir) = $medium->{url} =~ /(?:file|removable)[^:]*:\/(.*)/) {
	    my %infos;
	    my @mntpoints = $urpm->find_mntpoints($dir, \%infos);
	    if (@mntpoints > 1) { #- return value is suitable for an hash.
		$urpm->{log}(N("too many mount points for removable medium \"%s\"", $medium->{name}));
		$urpm->{log}(N("taking removable device as \"%s\"", join ',', map { $infos{$_}{device} } @mntpoints));
	    }
	    if (@mntpoints) {
		if ($medium->{removable} && $medium->{removable} ne $infos{$mntpoints[-1]}{device}) {
		    $urpm->{log}(N("using different removable device [%s] for \"%s\"",
				   $infos{$mntpoints[-1]}{device}, $medium->{name}));
		}
		$medium->{removable} = $infos{$mntpoints[-1]}{device};
	    } else {
		$urpm->{error}(N("unable to retrieve pathname for removable medium \"%s\"", $medium->{name}));
	    }
	} else {
	    $urpm->{error}(N("unable to retrieve pathname for removable medium \"%s\"", $medium->{name}));
	}
    }
}

#- write back urpmi.cfg code to allow modification of medium listed.
sub write_config {
    my ($urpm) = @_;

    #- avoid trashing exiting configuration in this case.
    $urpm->{media} or return;

    local (*F, *MD5SUM);
    open F, ">$urpm->{config}" or $urpm->{fatal}(6, N("unable to write config file [%s]", $urpm->{config}));
    open MD5SUM, ">$urpm->{statedir}/MD5SUM";
    if (%{$urpm->{options} || {}}) {
	printf F "{\n";
	while (my ($k, $v) = each %{$urpm->{options}}) {
	    printf F "  %s: %s\n", $k, $v;
	}
	printf F "}\n\n";
    }
    foreach my $medium (@{$urpm->{media}}) {
	printf F "%s %s {\n", quotespace($medium->{name}), quotespace($medium->{clear_url});
	foreach (qw(hdlist with_hdlist list removable key-ids)) {
	    $medium->{$_} and printf F "  %s: %s\n", $_, $medium->{$_};
	}
	$medium->{md5sum} and print MD5SUM "$medium->{md5sum}  ".($medium->{synthesis} && "synthesis.").$medium->{hdlist}."\n";
	foreach (qw(update ignore synthesis modified virtual)) {
	    $medium->{$_} and printf F "  %s\n", $_;
	}
	printf F "}\n\n";
    }
    close MD5SUM;
    close F;
    $urpm->{log}(N("write config file [%s]", $urpm->{config}));

    #- everything should be synced now.
    delete $urpm->{modified};
}

#- read urpmi.cfg file as well as synthesis file needed.
sub configure {
    my ($urpm, %options) = @_;

    $urpm->clean;

    if ($options{parallel}) {
	my ($parallel_options, $parallel_handler);
	#- handle parallel configuration, examine all module available that
	#- will handle the parallel mode (configuration is /etc/urpmi/parallel.cfg).
	local ($_, *PARALLEL);
	open PARALLEL, "/etc/urpmi/parallel.cfg";
	while (<PARALLEL>) {
	    chomp; s/#.*$//; s/^\s*//; s/\s*$//;
	    /\s*([^:]*):(.*)/ or $urpm->{error}(N("unable to parse \"%s\" in file [%s]", $_, "/etc/urpmi/parallel.cfg")), next;
	    $1 eq $options{parallel} and $parallel_options = ($parallel_options && "\n") . $2;
	}
	close PARALLEL;
	#- if a configuration options has been found, use it else fatal error.
	if ($parallel_options) {
	    foreach my $dir (grep { -d $_ } map { "$_/urpm" } @INC) {
		local *DIR;
		opendir DIR, $dir;
		while ($_ = readdir DIR) {
		    -f "$dir/$_" or next;
		    $urpm->{log}->(N("examining parallel handler in file [%s]", "$dir/$_"));
		    eval { require "$dir/$_"; $parallel_handler = $urpm->handle_parallel_options($parallel_options) };
		    $parallel_handler and last;
		}
		closedir DIR;
		$parallel_handler and last;
	    }
	}
	if ($parallel_handler) {
	    if ($parallel_handler->{nodes}) {
		$urpm->{log}->(N("found parallel handler for nodes: %s", join(', ', keys %{$parallel_handler->{nodes}})));
	    }
	    if (!$options{media} && $parallel_handler->{media}) {
		$options{media} = $parallel_handler->{media};
		$urpm->{log}->(N("using associated media for parallel mode: %s", $options{media}));
	    }
	    $urpm->{parallel_handler} = $parallel_handler;
	} else {
	    $urpm->{fatal}(1, N("unable to use parallel option \"%s\"", $options{parallel}));
	}
    } else {
	#- parallel is exclusive against root options.
	$urpm->{root} = $options{root};
    }

    if ($options{synthesis}) {
	if ($options{synthesis} ne 'none') {
	    #- synthesis take precedence over media, update options.
	    $options{media} || $options{excludemedia} || $options{sortmedia} || $options{update} || $options{parallel} and
	      $urpm->{fatal}(1, N("--synthesis cannot be used with --media, --excludemedia, --sortmedia, --update or --parallel"));
	    $urpm->parse_synthesis($options{synthesis});
	    #- synthesis disable the split of transaction (too risky and not usefull).
	    $urpm->{options}{'split-length'} = 0;
	}
    } else {
	$urpm->read_config(%options);
	if ($options{media}) {
	    delete $_->{modified} foreach @{$urpm->{media} || []};
	    $urpm->select_media(split ',', $options{media});
	    foreach (grep { !$_->{modified} } @{$urpm->{media} || []}) {
		#- this is only a local ignore that will not be saved.
		$_->{ignore} = 1;
	    }
	}
	if ($options{excludemedia}) {
	    delete $_->{modified} foreach @{$urpm->{media} || []};
	    $urpm->select_media(split ',', $options{excludemedia});
	    foreach (grep { $_->{modified} } @{$urpm->{media} || []}) {
		#- this is only a local ignore that will not be saved.
		$_->{ignore} = 1;
	    }
	}
	if ($options{sortmedia}) {
	    delete $_->{modified} foreach @{$urpm->{media} || []};
	    my @oldmedia = @{$urpm->{media} || []};
	    my @newmedia;
	    foreach (split ',', $options{sortmedia}) {
		$urpm->select_media($_);
		push @newmedia, grep { $_->{modified} } @oldmedia;
		@oldmedia = grep { !$_->{modified} } @oldmedia;
	    }
	    #- anything not selected should be added as is after the selected one.
	    $urpm->{media} = [ @newmedia, @oldmedia ];
	    #- clean remaining modified flag.
	    delete $_->{modified} foreach @{$urpm->{media} || []};
	}
	unless ($options{nodepslist}) {
	    foreach (grep { !$_->{ignore} && (!$options{update} || $_->{update}) } @{$urpm->{media} || []}) {
		delete @{$_}{qw(start end)};
		if ($_->{virtual}) {
		    my $path = $_->{url} =~ /^file:\/*(\/[^\/].*[^\/])\/*$/ && $1;
		    if ($path) {
			if ($_->{synthesis}) {
			    $urpm->{log}(N("examining synthesis file [%s]", "$path/$_->{with_hdlist}"));
			    eval { ($_->{start}, $_->{end}) = $urpm->parse_synthesis("$path/$_->{with_hdlist}",
										     callback => $options{callback}) };
			} else {
			    $urpm->{log}(N("examining hdlist file [%s]", "$path/$_->{with_hdlist}"));
			    eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$path/$_->{with_hdlist}",
										  packing => 1, callback => $options{callback}) };
			}
		    } else {
			$urpm->{error}(N("virtual medium \"%s\" is not local, medium ignored", $_->{name}));
			$_->{ignore} = 1;
		    }
		} else {
		    if ($options{hdlist} && -s "$urpm->{statedir}/$_->{hdlist}" > 32) {
			$urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}"));
			eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}",
									      packing => 1, callback => $options{callback}) };
		    } else {
			$urpm->{log}(N("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$_->{hdlist}"));
			eval { ($_->{start}, $_->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$_->{hdlist}",
										 callback => $options{callback}) };
			unless (defined $_->{start} && defined $_->{end}) {
			    $urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$_->{hdlist}"));
			    eval { ($_->{start}, $_->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$_->{hdlist}",
										  packing => 1, callback => $options{callback}) };
			}
		    }
		}
		unless ($_->{ignore}) {
		    unless (defined $_->{start} && defined $_->{end}) {
			$urpm->{error}(N("problem reading hdlist or synthesis file of medium \"%s\"", $_->{name}));
			$_->{ignore} = 1;
		    }
		}
	    }
	}
    }
    #- determine package to withdraw (from skip.list file) only if something should be withdrawn.
    unless ($options{noskipping}) {
	$urpm->compute_flags($urpm->get_packages_list($urpm->{skiplist}, $options{skip}), skip => 1, callback => sub {
				 my ($urpm, $pkg) = @_;
				 $urpm->{log}(N("skipping package %s", scalar($pkg->fullname)));
			     });
    }
    unless ($options{noinstalling}) {
	$urpm->compute_flags($urpm->get_packages_list($urpm->{instlist}, $options{inst}), disable_obsolete => 1, callback => sub {
				 my ($urpm, $pkg) = @_;
				 $urpm->{log}(N("would install instead of upgrade package %s", scalar($pkg->fullname)));
			     });
    }
    if ($options{bug}) {
	#- and a dump of rpmdb itself as synthesis file.
	my $db = URPM::DB::open($options{root});
	my $sig_handler = sub { undef $db; exit 3 };
	local $SIG{INT} = $sig_handler;
	local $SIG{QUIT} = $sig_handler;
	local *RPMDB;

	$db or $urpm->{fatal}(9, N("unable to open rpmdb"));
	open RPMDB, "| " . ($ENV{LD_LOADER} || '') . " gzip -9 >'$options{bug}/rpmdb.cz'";
	$db->traverse(sub {
			  my ($p) = @_;
			  #- this is not right but may be enough.
			  my $files = join '@', grep { exists($urpm->{provides}{$_}) } $p->files;
			  $p->pack_header;
			  $p->build_info(fileno *RPMDB, $files);
		      });
	close RPMDB;
    }
}

#- add a new medium, sync the config file accordingly.
sub add_medium {
    my ($urpm, $name, $url, $with_hdlist, %options) = @_;

    #- make sure configuration has been read.
    $urpm->{media} or $urpm->read_config();

    #- if a medium with that name has already been found
    #- we have to exit now
    my ($medium);
    if (defined $options{index_name}) {
	my $i = $options{index_name};
	do {
	    ++$i;
	    undef $medium;
	    foreach (@{$urpm->{media}}) {
		$_->{name} eq $name.$i and $medium = $_;
	    }
	} while $medium;
	$name .= $i;
    } else {
	foreach (@{$urpm->{media}}) {
	    $_->{name} eq $name and $medium = $_;
	}
    }
    $medium and $urpm->{fatal}(5, N("medium \"%s\" already exists", $medium->{name}));

    #- clear URLs for trailing /es.
    $url =~ s|(.*?)/*$|$1|;

    #- creating the medium info.
    if ($options{virtual}) {
	$url =~ m|^file:/*(/[^/].*)/| or $urpm->{fatal}(1, N("virtual medium need to be local"));

	$medium = { name      => $name,
		    url       => $url,
		    update    => $options{update},
		    virtual   => 1,
		    modified  => 1,
		  };
    } else {
	$medium = { name     => $name,
		    url      => $url,
		    hdlist   => "hdlist.$name.cz",
		    list     => "list.$name",
		    update   => $options{update},
		    modified => 1,
		  };

	#- check to see if the medium is using file protocol or removable medium.
	$url =~ /^(removable[^:]*|file):\/(.*)/ and $urpm->probe_removable_device($medium);
    }

    #- check if a password is visible, if not set clear_url.
    $url =~ m|([^:]*://[^/:\@]*:)[^/:\@]*(\@.*)| or $medium->{clear_url} = $url;

    #- all flags once everything has been computed.
    $with_hdlist and $medium->{with_hdlist} = $with_hdlist;

    #- create an entry in media list.
    push @{$urpm->{media}}, $medium;

    #- keep in mind the database has been modified and base files need to be updated.
    #- this will be done automatically by transfering modified flag from medium to global.
    $urpm->{log}(N("added medium %s", $name));
}

#- add distribution media, according to url given.
sub add_distrib_media {
    my ($urpm, $name, $url, %options) = @_;
    my ($hdlists_file);

    #- make sure configuration has been read.
    $urpm->{media} or $urpm->read_config();

    #- try to copy/retrive Mandrake/basehdlists file.
    if (my ($dir) = $url =~ /^(?:removable[^:]*|file):\/(.*)/) {
	$hdlists_file = reduce_pathname("$dir/Mandrake/base/hdlists");

	$urpm->try_mounting($hdlists_file) or $urpm->{error}(N("unable to access first installation medium")), return;

	if (-e $hdlists_file) {
	    unlink "$urpm->{cachedir}/partial/hdlists";
	    $urpm->{log}(N("copying hdlists file..."));
	    system("cp", "--preserve=mode", "--preserve=timestamps", "-R", $hdlists_file, "$urpm->{cachedir}/partial/hdlists") ?
	      $urpm->{log}(N("...copying failed")) : $urpm->{log}(N("...copying done"));
	} else {
	    $urpm->{error}(N("unable to access first installation medium (no Mandrake/base/hdlists file found)")), return;
	}
    } else {
	#- try to get the description if it has been found.
	unlink "$urpm->{cachedir}/partial/hdlists";
	eval {
	    $urpm->{log}(N("retrieving hdlists file..."));
	    $urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
			    quiet => 1,
			    limit_rate => $options{limit_rate},
			    compress => $options{compress},
			    proxy => $urpm->{proxy} },
			  reduce_pathname("$url/Mandrake/base/hdlists"));
	    $urpm->{log}(N("...retrieving done"));
	};
	$@ and $urpm->{log}(N("...retrieving failed: %s", $@));
	if (-e "$urpm->{cachedir}/partial/hdlists") {
	    $hdlists_file = "$urpm->{cachedir}/partial/hdlists";
	} else {
	    $urpm->{error}(N("unable to access first installation medium (no Mandrake/base/hdlists file found)")), return;
	}
    }

    #- cosmetic update of name if it contains blank char.
    $name =~ /\s/ and $name .= ' ';

    #- at this point, we have found an hdlists file, so parse it
    #- and create all necessary medium according to it.
    local *HDLISTS;
    if (open HDLISTS, $hdlists_file) {
	my $medium = 1;
	foreach (<HDLISTS>) {
	    chomp;
	    s/\s*#.*$//;
	    /^\s*$/ and next;
	    m/^\s*(?:noauto:)?(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or $urpm->{error}(N("invalid hdlist description \"%s\" in hdlists file"), $_);
	    my ($hdlist, $rpmsdir, $descr) = ($1, $2, $3);

	    $urpm->add_medium($name ? "$descr ($name$medium)" : $descr, "$url/$rpmsdir", "../base/$hdlist", %options);

	    ++$medium;
	}
	close HDLISTS;
    } else {
	$urpm->{error}(N("unable to access first installation medium (no Mandrake/base/hdlists file found)")), return;
    }
}

sub select_media {
    my $urpm = shift;
    my %media; @media{@_} = undef;

    foreach (@{$urpm->{media}}) {
	if (exists($media{$_->{name}})) {
	    $media{$_->{name}} = 1; #- keep it mind this one has been selected.

	    #- select medium by setting modified flags, do not check ignore.
	    $_->{modified} = 1;
	}
    }

    #- check if some arguments does not correspond to medium name.
    #- in such case, try to find the unique medium (or list candidate
    #- media found).
    foreach (keys %media) {
	unless ($media{$_}) {
	    my $q = quotemeta;
	    my (@found, @foundi);
	    foreach my $medium (@{$urpm->{media}}) {
		$medium->{name} =~ /$q/ and push @found, $medium;
		$medium->{name} =~ /$q/i and push @foundi, $medium;
	    }
	    if (@found == 1) {
		$found[0]{modified} = 1;
	    } elsif (@foundi == 1) {
		$foundi[0]{modified} = 1;
	    } elsif (@found == 0 && @foundi == 0) {
		$urpm->{error}(N("trying to select nonexistent medium \"%s\"", $_));
	    } else { #- multiple element in found or foundi list.
		$urpm->{log}(N("selecting multiple media: %s", join(", ", map { N("\"%s\"", $_->{name}) } (@found ? @found : @foundi))));
		#- changed behaviour to select all occurence by default.
		foreach (@found ? @found : @foundi) {
		    $_->{modified} = 1;
		}
	    }
	}
    }
}

sub remove_selected_media {
    my ($urpm) = @_;
    my @result;
    
    foreach (@{$urpm->{media}}) {
	if ($_->{modified}) {
	    $urpm->{log}(N("removing medium \"%s\"", $_->{name}));

	    #- mark to re-write configuration.
	    $urpm->{modified} = 1;

	    #- remove file associated with this medium.
	    foreach ($_->{hdlist}, $_->{list}, "synthesis.$_->{hdlist}", "descriptions.$_->{name}", "$_->{name}.cache") {
		$_ and unlink "$urpm->{statedir}/$_";
	    }
	} else {
	    push @result, $_; #- not removed so keep it
	}
    }

    #- restore newer media list.
    $urpm->{media} = \@result;
}

#- return list of synthesis or hdlist reference to probe.
sub probe_with_try_list {
    my ($suffix, $probe_with) = @_;

    my @probe = ("synthesis.hdlist.cz", "synthesis.hdlist$suffix.cz",
		 "../synthesis.hdlist$suffix.cz", "../base/synthesis.hdlist$suffix.cz");

    defined $suffix && !$suffix and push @probe, ("synthesis.hdlist1.cz", "synthesis.hdlist2.cz",
						  "../synthesis.hdlist1.cz", "../synthesis.hdlist2.cz",
						  "../base/synthesis.hdlist1.cz", "../base/synthesis.hdlist2.cz");

    my @probe_hdlist = ("hdlist.cz", "hdlist$suffix.cz", "../hdlist$suffix.cz", "../base/hdlist$suffix.cz");
    defined $suffix && !$suffix and push @probe_hdlist, ("hdlist1.cz", "hdlist2.cz",
							 "../hdlist1.cz", "../hdlist2.cz",
							 "../base/hdlist1.cz", "../base/hdlist2.cz");

    if ($probe_with =~ /synthesis/) {
	push @probe, @probe_hdlist;
    } else {
	unshift @probe, @probe_hdlist;
    }

    @probe;
}

#- update urpmi database regarding the current configuration.
#- take care of modification and try some trick to bypass
#- computational of base files.
#- allow options :
#-   all         -> all medium are rebuilded.
#-   force       -> try to force rebuilding base files (1) or hdlist from rpm files (2).
#-   probe_with  -> probe synthesis or hdlist.
#-   ratio       -> use compression ratio (with gzip, default is 4)
#-   noclean     -> keep header directory cleaned.
sub update_media {
    my ($urpm, %options) = @_; #- do not trust existing hdlist and try to recompute them.
    my ($cleaned_cache);

    #- take care of some options.
    $cleaned_cache = !$options{noclean};

    #- avoid trashing existing configuration in this case.
    $urpm->{media} or return;

    #- now we need additional methods not defined by default in URPM.
    require URPM::Build;
    require URPM::Signature;

    #- get gpg-pubkey signature.
    $options{nopubkey} or $urpm->exlock_rpm_db;
    $options{nopubkey} or $urpm->{keys} or $urpm->parse_pubkeys(root => $urpm->{root});

    #- lock database if allowed.
    $options{nolock} or $urpm->exlock_urpmi_db;

    #- examine each medium to see if one of them need to be updated.
    #- if this is the case and if not forced, try to use a pre-calculated
    #- hdlist file else build it from rpm files.
    $urpm->clean;
    foreach my $medium (@{$urpm->{media}}) {
	#- take care of modified medium only or all if all have to be recomputed.
	$medium->{ignore} and next;

	#- and create synthesis file associated if it does not already exists...
	-s "$urpm->{statedir}/synthesis.$medium->{hdlist}" > 32 or $medium->{modified_synthesis} = 1;

	#- but do not take care of removable media for all.
	$medium->{modified} ||= $options{all} && $medium->{url} !~ /removable/;
	unless ($medium->{modified}) {
	    #- the medium is not modified, but for computing dependencies,
	    #- we still need to read it and all synthesis will be written if
	    #- a unresolved provides is found.
	    #- to speed up the process, we only read the synthesis at the begining.
	    delete @{$medium}{qw(start end)};
	    if ($medium->{virtual}) {
		my ($path) = $medium->{url} =~ /^file:\/*(\/[^\/].*[^\/])\/*$/;
		my $with_hdlist_file = "$path/$medium->{with_hdlist}";
		if ($path) {
		    if ($medium->{synthesis}) {
			$urpm->{log}(N("examining synthesis file [%s]", $with_hdlist_file));
			eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis($with_hdlist_file) };
		    } else {
			$urpm->{log}(N("examining hdlist file [%s]", $with_hdlist_file));
			eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist($with_hdlist_file, packing => 1) };
		    }
		} else {
		    $urpm->{error}(N("virtual medium \"%s\" is not local, medium ignored", $medium->{name}));
		    $_->{ignore} = 1;
		}
	    } else {
		$urpm->{log}(N("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
		eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") };
		unless (defined $medium->{start} && defined $medium->{end}) {
		    $urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
		    eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", packing => 1) };
		}
	    }
	    unless ($medium->{ignore}) {
		unless (defined $medium->{start} && defined $medium->{end}) {
		    #- this is almost a fatal error, ignore it by default?
		    $urpm->{error}(N("problem reading hdlist or synthesis file of medium \"%s\"", $medium->{name}));
		    $medium->{ignore} = 1;
		}
	    }
	    next;
	}

	#- list of rpm files for this medium, only available for local medium where
	#- the source hdlist is not used (use force).
	my ($prefix, $dir, $error, $retrieved_md5sum, @files);

	#- always delete a remaining list file or pubkey file in cache.
	foreach (qw(list pubkey)) {
	    unlink "$urpm->{cachedir}/partial/$_";
	}

	#- check to see if the medium is using file protocol or removable medium.
	if (($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) {
	    #- try to figure a possible hdlist_path (or parent directory of searched directory.
	    #- this is used to probe possible hdlist file.
	    my $with_hdlist_dir = reduce_pathname($dir . ($medium->{with_hdlist} ? "/$medium->{with_hdlist}" : "/.."));

	    #- the directory given does not exist and may be accessible
	    #- by mounting some other. try to figure out these directory and
	    #- mount everything necessary.
	    $urpm->try_mounting($options{force} < 2 && ($options{probe_with} || $medium->{with_hdlist}) ?
				$with_hdlist_dir : $dir) or
				  $urpm->{error}(N("unable to access medium \"%s\",
this could happen if you mounted manually the directory when creating the medium.", $medium->{name})), next;

	    #- try to probe for possible with_hdlist parameter, unless
	    #- it is already defined (and valid).
	    if ($options{probe_with} && (!$medium->{with_hdlist} || ! -e "$dir/$medium->{with_hdlist}")) {
		my ($suffix) = $dir =~ /RPMS([^\/]*)\/*$/;

		foreach (probe_with_try_list($suffix, $options{probe_with})) {
		    if (-s "$dir/$_" > 32) {
			$medium->{with_hdlist} = $_;
			last;
		    }
		}
		#- redo...
		$with_hdlist_dir = reduce_pathname($dir . ($medium->{with_hdlist} ? "/$medium->{with_hdlist}" : "/.."));
	    }

	    if ($medium->{virtual}) {
		#- syncing a virtual medium is very simple, just try to read the file in order to
		#- determine its type, once a with_hdlist has been found (but is mandatory).
		if ($medium->{with_hdlist} && -e $with_hdlist_dir) {
		    delete @{$medium}{qw(start end)};
		    if ($medium->{synthesis}) {
			$urpm->{log}(N("examining synthesis file [%s]", $with_hdlist_dir));
			eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis($with_hdlist_dir);
			       delete $medium->{modified};
			       $medium->{synthesis} = 1;
			       $urpm->{modified} = 1 };
			unless (defined $medium->{start} && defined $medium->{end}) {
			    $urpm->{log}(N("examining hdlist file [%s]", $with_hdlist_dir));
			    eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist($with_hdlist_dir, packing => 1);
				   delete @{$medium}{qw(modified synthesis)};
				   $urpm->{modified} = 1 };
			}
		    } else {
			$urpm->{log}(N("examining hdlist file [%s]", $with_hdlist_dir));
			eval { ($medium->{start}, $medium->{end}) = $urpm->parse_hdlist($with_hdlist_dir, packing => 1);
			       delete @{$medium}{qw(modified synthesis)};
			       $urpm->{modified} = 1 };
			unless (defined $medium->{start} && defined $medium->{end}) {
			    $urpm->{log}(N("examining synthesis file [%s]", $with_hdlist_dir));
			    eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis($with_hdlist_dir);
				   delete $medium->{modified};
				   $medium->{synthesis} = 1;
				   $urpm->{modified} = 1 };
			}
		    }
		    unless (defined $medium->{start} && defined $medium->{end}) {
			$urpm->{error}(N("problem reading hdlist or synthesis file of medium \"%s\"", $medium->{name}));
			$medium->{ignore} = 1;
		    }
		} else {
		    $urpm->{error}(N("virtual medium \"%s\" should have valid source hdlist or synthesis, medium ignored",
				     $medium->{name}));
		    $medium->{ignore} = 1;
		}
		next;
	    }
	    #- try to get the description if it has been found.
	    unlink "$urpm->{statedir}/descriptions.$medium->{name}";
	    if (-e "$dir/../descriptions") {
		$urpm->{log}(N("copying description file of \"%s\"...", $medium->{name}));
		system("cp", "--preserve=mode", "--preserve=timestamps", "-R", "$dir/../descriptions",
		       "$urpm->{statedir}/descriptions.$medium->{name}") ?
			 $urpm->{log}(N("...copying failed")) : $urpm->{log}(N("...copying done"));
	    }

	    #- examine if a distant MD5SUM file is available.
	    #- this will only be done if $with_hdlist is not empty in order to use
	    #- an existing hdlist or synthesis file, and to check if download was good.
	    #- if no MD5SUM are available, do it as before...
	    if ($medium->{with_hdlist}) {
		#- we can assume at this point a basename is existing, but it needs
		#- to be checked for being valid, nothing can be deduced if no MD5SUM
		#- file are present.
		my $basename = basename($with_hdlist_dir);

		if (!$options{nomd5sum} && -s reduce_pathname("$with_hdlist_dir/../MD5SUM") > 32) {
		    if ($options{force}) {
			#- force downloading the file again, else why a force option has been defined ?
			delete $medium->{md5sum};
		    } else {
			unless ($medium->{md5sum}) {
			    $urpm->{log}(N("computing md5sum of existing source hdlist (or synthesis)"));
			    if ($medium->{synthesis}) {
				-e "$urpm->{statedir}/synthesis.$medium->{hdlist}" and
				  $medium->{md5sum} = (split ' ', `md5sum '$urpm->{statedir}/synthesis.$medium->{hdlist}'`)[0];
			    } else {
				-e "$urpm->{statedir}/$medium->{hdlist}" and
				  $medium->{md5sum} = (split ' ', `md5sum '$urpm->{statedir}/$medium->{hdlist}'`)[0];
			    }
			}
		    }
		    if ($medium->{md5sum}) {
			$urpm->{log}(N("examining MD5SUM file"));
			local (*F, $_);
			open F, reduce_pathname("$with_hdlist_dir/../MD5SUM");
			while (<F>) {
			    my ($md5sum, $file) = /(\S+)\s+(?:\.\/)?(\S+)/ or next;
			    #- keep md5sum got here to check download was ok ! so even if md5sum is not defined, we need
			    #- to compute it, keep it in mind ;)
			    $file eq $basename and $retrieved_md5sum = $md5sum;
			}
			close F;
			#- if an existing hdlist or synthesis file has the same md5sum, we assume the
			#- file are the same.
			#- if local md5sum is the same as distant md5sum, this means there is no need to
			#- download hdlist or synthesis file again.
			foreach (@{$urpm->{media}}) {
			    if ($_->{md5sum} && $_->{md5sum} eq $retrieved_md5sum) {
				unlink "$urpm->{cachedir}/partial/$basename";
				#- the medium is now considered not modified.
				$medium->{modified} = 0;
				#- hdlist or synthesis file must be linked with the other same one.
				#- a link is better for reducing used size of /var/lib/urpmi.
				if ($_ ne $medium) {
				    $medium->{md5sum} = $_->{md5sum};
				    unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
				    unlink "$urpm->{statedir}/$medium->{hdlist}";
				    symlink "synthesis.$_->{hdlist}", "$urpm->{statedir}/synthesis.$medium->{hdlist}";
				    symlink $_->{hdlist}, "$urpm->{statedir}/$medium->{hdlist}";
				}
				#- as previously done, just read synthesis file here, this is enough.
				$urpm->{log}(N("examining synthesis file [%s]",
					       "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
				eval { ($medium->{start}, $medium->{end}) =
					 $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") };
				unless (defined $medium->{start} && defined $medium->{end}) {
				    $urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
				    eval { ($medium->{start}, $medium->{end}) =
					     $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", packing => 1) };
				    unless (defined $medium->{start} && defined $medium->{end}) {
					$urpm->{error}(N("problem reading hdlist or synthesis file of medium \"%s\"", $medium->{name}));
					$medium->{ignore} = 1;
				    }
				}
				#- no need to continue examining other md5sum.
				last;
			    }
			}
			$medium->{modified} or next;
		    }
		}
	    }

	    #- if the source hdlist is present and we are not forcing using rpms file
	    if ($options{force} < 2 && $medium->{with_hdlist} && -e $with_hdlist_dir) {
		unlink "$urpm->{cachedir}/partial/$medium->{hdlist}";
		$urpm->{log}(N("copying source hdlist (or synthesis) of \"%s\"...", $medium->{name}));
		$options{callback} && $options{callback}('copy', $medium->{name});
		if (system("cp", "--preserve=mode", "--preserve=timestamps", "-R", $with_hdlist_dir,
			   "$urpm->{cachedir}/partial/$medium->{hdlist}")) {
		    $options{callback} && $options{callback}('failed', $medium->{name});
		    $urpm->{log}(N("...copying failed"));
		    unlink "$urpm->{cachedir}/partial/$medium->{hdlist}"; #- force error...
		} else {
		    $options{callback} && $options{callback}('done', $medium->{name});
		    $urpm->{log}(N("...copying done"));
		}

		-s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 32 or
		  $error = 1, $urpm->{error}(N("copy of [%s] failed", $with_hdlist_dir));

		#- keep checking md5sum of file just copied ! (especially on nfs or removable device).
		if (!$error && $retrieved_md5sum) {
		    $urpm->{log}(N("computing md5sum of copied source hdlist (or synthesis)"));
		    (split ' ', `md5sum '$urpm->{cachedir}/partial/$medium->{hdlist}'`)[0] eq $retrieved_md5sum or
		      $error = 1, $urpm->{error}(N("copy of [%s] failed", $with_hdlist_dir));
		}

		#- check if the file are equals... and no force copy...
		if (!$error && !$options{force} && -e "$urpm->{statedir}/synthesis.$medium->{hdlist}") {
		    my @sstat = stat "$urpm->{cachedir}/partial/$medium->{hdlist}";
		    my @lstat = stat "$urpm->{statedir}/$medium->{hdlist}";
		    if ($sstat[7] == $lstat[7] && $sstat[9] == $lstat[9]) {
			#- the two files are considered equal here, the medium is so not modified.
			$medium->{modified} = 0;
			unlink "$urpm->{cachedir}/partial/$medium->{hdlist}";
			#- as previously done, just read synthesis file here, this is enough, but only
			#- if synthesis exists, else it need to be recomputed.
			$urpm->{log}(N("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
			eval { ($medium->{start}, $medium->{end}) =
				 $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") };
			unless (defined $medium->{start} && defined $medium->{end}) {
			    $urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
			    eval { ($medium->{start}, $medium->{end}) =
				     $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", packing => 1) };
			    unless (defined $medium->{start} && defined $medium->{end}) {
				$urpm->{error}(N("problem reading synthesis file of medium \"%s\"", $medium->{name}));
				$medium->{ignore} = 1;
			    }
			}
			next;
		    }
		}
	    } else {
		$options{force} < 2 and $options{force} = 2;
	    }

	    #- if copying hdlist has failed, try to build it directly.
	    if ($error) {
		$options{force} < 2 and $options{force} = 2;
		#- clean error state now.
		$error = undef;
	    }

	    if ($options{force} < 2) {
		#- examine if a local list file is available (always probed according to with_hdlist
		#- and check hdlist has not be named very strangely...
		if ($medium->{hdlist} ne 'list') {
		    my $local_list = $medium->{with_hdlist} =~ /hd(list.*)\.cz2?$/ ? $1 : 'list';
		    my $path_list = reduce_pathname("$with_hdlist_dir/../$local_list");
		    -s $path_list or $path_list = "$dir/list";
		    -s $path_list and system("cp", "--preserve=mode", "--preserve=timestamps", "-R",
					     $path_list, "$urpm->{cachedir}/partial/list");
		}
	    } else {
		#- try to find rpm files, use recursive method, added additional
		#- / after dir to make sure it will be taken into account if this
		#- is a symlink to a directory.
		#- make sure rpm filename format is correct and is not a source rpm
		#- which are not well managed by urpmi.
		@files = split "\n", `find '$dir/' -name "*.rpm" -print`;

		#- check files contains something good!
		if (@files > 0) {
		    #- we need to rebuild from rpm files the hdlist.
		    eval {
			$urpm->{log}(N("reading rpm files from [%s]", $dir));
			my @unresolved_before = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}};
			$medium->{start} = @{$urpm->{depslist}};
			$medium->{headers} = [ $urpm->parse_rpms_build_headers(dir   => "$urpm->{cachedir}/headers",
									       rpms  => \@files,
									       clean => $cleaned_cache,
									      ) ];
			$medium->{end} = $#{$urpm->{depslist}};
			if ($medium->{start} > $medium->{end}) {
			    #- an error occured (provided there are files in input.
			    delete $medium->{start};
			    delete $medium->{end};
			    die "no rpms read\n";
			} else {
			    $cleaned_cache = 0; #- make sure the headers will not be removed for another media.
			    my @unresolved_after = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}};
			    @unresolved_before == @unresolved_after or $urpm->{second_pass} = 1;
			}
		    };
		    $@ and $error = 1, $urpm->{error}(N("unable to read rpm files from [%s]: %s", $dir, $@));
		    $error and delete $medium->{headers}; #- do not propagate these.
		    $error or delete $medium->{synthesis}; #- when building hdlist by ourself, drop synthesis property.
		} else {
		    $error = 1;
		    $urpm->{error}(N("no rpm files found from [%s]", $dir));
		}
	    }

	    #- examine if a local pubkey file is available.
	    if (!$options{nopubkey} && $medium->{hdlist} ne 'pubkey' && !$medium->{'key-ids'}) {
		my $local_pubkey = $medium->{with_hdlist} =~ /hdlist(.*)\.cz2?$/ ? "pubkey$1" : 'pubkey';
		my $path_pubkey = reduce_pathname("$with_hdlist_dir/../$local_pubkey");
		-s $path_pubkey or $path_pubkey = "$dir/pubkey";
		-s $path_pubkey and system("cp", "--preserve=mode", "--preserve=timestamps", "-R",
					   $path_pubkey, "$urpm->{cachedir}/partial/pubkey");
	    }
	} else {
	    my $basename;

	    #- try to get the description if it has been found.
	    unlink "$urpm->{cachedir}/partial/descriptions";
	    if (-e "$urpm->{statedir}/descriptions.$medium->{name}") {
		rename("$urpm->{statedir}/descriptions.$medium->{name}", "$urpm->{cachedir}/partial/descriptions") or 
		  system("mv", "$urpm->{statedir}/descriptions.$medium->{name}", "$urpm->{cachedir}/partial/descriptions");
	    }
	    eval {
		$urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
				quiet => 1,
				limit_rate => $options{limit_rate},
				compress => $options{compress},
				proxy => $urpm->{proxy} },
			      reduce_pathname("$medium->{url}/../descriptions"));
	    };
	    if (-e "$urpm->{cachedir}/partial/descriptions") {
		rename("$urpm->{cachedir}/partial/descriptions", "$urpm->{statedir}/descriptions.$medium->{name}") or
		  system("mv", "$urpm->{cachedir}/partial/descriptions", "$urpm->{statedir}/descriptions.$medium->{name}");
	    }

	    #- examine if a distant MD5SUM file is available.
	    #- this will only be done if $with_hdlist is not empty in order to use
	    #- an existing hdlist or synthesis file, and to check if download was good.
	    #- if no MD5SUM are available, do it as before...
	    if ($medium->{with_hdlist}) {
		#- we can assume at this point a basename is existing, but it needs
		#- to be checked for being valid, nothing can be deduced if no MD5SUM
		#- file are present.
		$basename = basename($medium->{with_hdlist});

		unlink "$urpm->{cachedir}/partial/MD5SUM";
		eval {
		    if (!$options{nomd5sum}) {
			$urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
					quiet => 1,
					limit_rate => $options{limit_rate},
					compress => $options{compress},
					proxy => $urpm->{proxy} },
				      reduce_pathname("$medium->{url}/$medium->{with_hdlist}/../MD5SUM"));
		    }
		};
		if (!$@ && -s "$urpm->{cachedir}/partial/MD5SUM" > 32) {
		    if ($options{force} >= 2) {
			#- force downloading the file again, else why a force option has been defined ?
			delete $medium->{md5sum};
		    } else {
			unless ($medium->{md5sum}) {
			    $urpm->{log}(N("computing md5sum of existing source hdlist (or synthesis)"));
			    if ($medium->{synthesis}) {
				-e "$urpm->{statedir}/synthesis.$medium->{hdlist}" and
				  $medium->{md5sum} = (split ' ', `md5sum '$urpm->{statedir}/synthesis.$medium->{hdlist}'`)[0];
			    } else {
				-e "$urpm->{statedir}/$medium->{hdlist}" and
				  $medium->{md5sum} = (split ' ', `md5sum '$urpm->{statedir}/$medium->{hdlist}'`)[0];
			    }
			}
		    }
		    if ($medium->{md5sum}) {
			$urpm->{log}(N("examining MD5SUM file"));
			local (*F, $_);
			open F, "$urpm->{cachedir}/partial/MD5SUM";
			while (<F>) {
			    my ($md5sum, $file) = /(\S+)\s+(?:\.\/)?(\S+)/ or next;
			    #- keep md5sum got here to check download was ok ! so even if md5sum is not defined, we need
			    #- to compute it, keep it in mind ;)
			    $file eq $basename and $retrieved_md5sum = $md5sum;
			}
			close F;
			#- if an existing hdlist or synthesis file has the same md5sum, we assume the
			#- file are the same.
			#- if local md5sum is the same as distant md5sum, this means there is no need to
			#- download hdlist or synthesis file again.
			foreach (@{$urpm->{media}}) {
			    if ($_->{md5sum} && $_->{md5sum} eq $retrieved_md5sum) {
				unlink "$urpm->{cachedir}/partial/$basename";
				#- the medium is now considered not modified.
				$medium->{modified} = 0;
				#- hdlist or synthesis file must be linked with the other same one.
				#- a link is better for reducing used size of /var/lib/urpmi.
				if ($_ ne $medium) {
				    $medium->{md5sum} = $_->{md5sum};
				    unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
				    unlink "$urpm->{statedir}/$medium->{hdlist}";
				    symlink "synthesis.$_->{hdlist}", "$urpm->{statedir}/synthesis.$medium->{hdlist}";
				    symlink $_->{hdlist}, "$urpm->{statedir}/$medium->{hdlist}";
				}
				#- as previously done, just read synthesis file here, this is enough.
				$urpm->{log}(N("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
				eval { ($medium->{start}, $medium->{end}) =
					 $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") };
				unless (defined $medium->{start} && defined $medium->{end}) {
				    $urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
				    eval { ($medium->{start}, $medium->{end}) =
					     $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", packing => 1) };
				    unless (defined $medium->{start} && defined $medium->{end}) {
					$urpm->{error}(N("problem reading synthesis file of medium \"%s\"", $medium->{name}));
					$medium->{ignore} = 1;
				    }
				}
				#- no need to continue examining other md5sum.
				last;
			    }
			}
			$medium->{modified} or next;
		    }
		} else {
		    #- at this point, we don't if a basename exists and is valid, let probe it later.
		    $basename = undef;
		}
	    }

	    #- try to probe for possible with_hdlist parameter, unless
	    #- it is already defined (and valid).
	    $urpm->{log}(N("retrieving source hdlist (or synthesis) of \"%s\"...", $medium->{name}));
	    $options{callback} && $options{callback}('retrieve', $medium->{name});
	    if ($options{probe_with}) {
		my ($suffix) = $dir =~ /RPMS([^\/]*)\/*$/;

		foreach my $with_hdlist ($medium->{with_hdlist}, probe_with_try_list($suffix, $options{probe_with})) {
		    $basename = basename($with_hdlist) or next;

		    $options{force} and unlink "$urpm->{cachedir}/partial/$basename";
		    eval {
			$urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
					quiet => 0,
					limit_rate => $options{limit_rate},
					compress => $options{compress},
					callback => $options{callback},
					proxy => $urpm->{proxy} }, reduce_pathname("$medium->{url}/$with_hdlist"));
		    };
		    if (!$@ && -s "$urpm->{cachedir}/partial/$basename" > 32) {
			$medium->{with_hdlist} = $with_hdlist;
			$urpm->{log}(N("found probed hdlist (or synthesis) as %s", $medium->{with_hdlist}));
			last; #- found a suitable with_hdlist in the list above.
		    }
		}
	    } else {
		$basename = basename($medium->{with_hdlist});

		#- try to sync (copy if needed) local copy after restored the previous one.
		$options{force} and unlink "$urpm->{cachedir}/partial/$basename";
		unless ($options{force}) {
		    if ($medium->{synthesis}) {
			-e "$urpm->{statedir}/synthesis.$medium->{hdlist}" and
			  system("cp", "--preserve=mode", "--preserve=timestamps", "-R",
				 "$urpm->{statedir}/synthesis.$medium->{hdlist}", "$urpm->{cachedir}/partial/$basename");
		    } else {
			-e "$urpm->{statedir}/$medium->{hdlist}" and
			  system("cp", "--preserve=mode", "--preserve=timestamps", "-R",
				 "$urpm->{statedir}/$medium->{hdlist}", "$urpm->{cachedir}/partial/$basename");
		    }
		}
		eval {
		    $urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
				    quiet => 0,
				    limit_rate => $options{limit_rate},
				    compress => $options{compress},
				    callback => $options{callback},
				    proxy => $urpm->{proxy} }, reduce_pathname("$medium->{url}/$medium->{with_hdlist}"));
		};
		if ($@) {
		    $urpm->{log}(N("...retrieving failed: %s", $@));
		    unlink "$urpm->{cachedir}/partial/$basename";
		}
	    }

	    #- check downloaded file has right signature.
	    if (-s "$urpm->{cachedir}/partial/$basename" > 32 && $retrieved_md5sum) {
		$urpm->{log}(N("computing md5sum of retrieved source hdlist (or synthesis)"));
		unless ((split ' ', `md5sum '$urpm->{cachedir}/partial/$basename'`)[0] eq $retrieved_md5sum) {
		    $urpm->{log}(N("...retrieving failed: %s", N("md5sum mismatch")));
		    unlink "$urpm->{cachedir}/partial/$basename";
		}
	    }

	    if (-s "$urpm->{cachedir}/partial/$basename" > 32) {
		$options{callback} && $options{callback}('done', $medium->{name});
		$urpm->{log}(N("...retrieving done"));

		unless ($options{force}) {
		    my @sstat = stat "$urpm->{cachedir}/partial/$basename";
		    my @lstat = stat "$urpm->{statedir}/$medium->{hdlist}";
		    if ($sstat[7] == $lstat[7] && $sstat[9] == $lstat[9]) {
			#- the two files are considered equal here, the medium is so not modified.
			$medium->{modified} = 0;
			unlink "$urpm->{cachedir}/partial/$basename";
			#- as previously done, just read synthesis file here, this is enough.
			$urpm->{log}(N("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
			eval { ($medium->{start}, $medium->{end}) =
				 $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") };
			unless (defined $medium->{start} && defined $medium->{end}) {
			    $urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
			    eval { ($medium->{start}, $medium->{end}) =
				     $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", packing => 1) };
			    unless (defined $medium->{start} && defined $medium->{end}) {
				$urpm->{error}(N("problem reading hdlist or synthesis file of medium \"%s\"", $medium->{name}));
				$medium->{ignore} = 1;
			    }
			}
			next;
		    }
		}

		#- the file are different, update local copy.
		rename("$urpm->{cachedir}/partial/$basename", "$urpm->{cachedir}/partial/$medium->{hdlist}");

		#- retrieve of hdlist or synthesis has been successfull, check if a list file is available.
		#- and check hdlist has not be named very strangely...
		if ($medium->{hdlist} ne 'list') {
		    my $local_list = $medium->{with_hdlist} =~ /hd(list.*)\.cz2?$/ ? $1 : 'list';
		    foreach (reduce_pathname("$medium->{url}/$medium->{with_hdlist}/../$local_list"),
			     reduce_pathname("$medium->{url}/list"),
			    ) {
			eval {
			    $urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
					    quiet => 1,
					    limit_rate => $options{limit_rate},
					    compress => $options{compress},
					    proxy => $urpm->{proxy} },
					  $_);
			    $local_list ne 'list' && -s "$urpm->{cachedir}/partial/$local_list" and
			      rename("$urpm->{cachedir}/partial/$local_list", "$urpm->{cachedir}/partial/list");
			};
			$@ and unlink "$urpm->{cachedir}/partial/list";
			-s "$urpm->{cachedir}/partial/list" and last;
		    }
		}

		#- retrieve pubkey file.
		if (!$options{nopubkey} && $medium->{hdlist} ne 'pubkey' && !$medium->{'key-ids'}) {
		    my $local_pubkey = $medium->{with_hdlist} =~ /hdlist(.*)\.cz2?$/ ? "pubkey$1" : 'pubkey';
		    foreach (reduce_pathname("$medium->{url}/$medium->{with_hdlist}/../$local_pubkey"),
			     reduce_pathname("$medium->{url}/pubkey"),
			    ) {
			eval {
			    $urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
					    quiet => 1,
					    limit_rate => $options{limit_rate},
					    compress => $options{compress},
					    proxy => $urpm->{proxy} },
					  $_);
			    $local_pubkey ne 'pubkey' && -s "$urpm->{cachedir}/partial/$local_pubkey" and
			      rename("$urpm->{cachedir}/partial/$local_pubkey", "$urpm->{cachedir}/partial/pubkey");
			};
			$@ and unlink "$urpm->{cachedir}/partial/pubkey";
			-s "$urpm->{cachedir}/partial/pubkey" and last;
		    }
		}
	    } else {
		$error = 1;
		$options{callback} && $options{callback}('failed', $medium->{name});
		$urpm->{error}(N("retrieve of source hdlist (or synthesis) failed"));
	    }
	}

	#- build list file according to hdlist used.
	unless ($medium->{headers} || -s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 32) {
	    $error = 1;
	    $urpm->{error}(N("no hdlist file found for medium \"%s\"", $medium->{name}));
	}

	#- make sure group and other does not have any access to this file.
	unless ($error) {
	    #- sort list file contents according to id.
	    my %list;
	    if ($medium->{headers}) {
		#- rpm files have already been read (first pass), there is just a need to
		#- build list hash.
		foreach (@files) {
		    /\/([^\/]*\.rpm)$/ or next;
		    $list{$1} and $urpm->{error}(N("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next;
		    $list{$1} = "$prefix:/$_\n";
		}
	    } else {
		#- read first pass hdlist or synthesis, try to open as synthesis, if file
		#- is larger than 1MB, this is probably an hdlist else a synthesis.
		#- anyway, if one tries fails, try another mode.
		$options{callback} && $options{callback}('parse', $medium->{name});
		my @unresolved_before = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}};
		if (!$medium->{synthesis} || -s "$urpm->{cachedir}/partial/$medium->{hdlist}" > 262144) {
		    $urpm->{log}(N("examining hdlist file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}"));
		    eval { ($medium->{start}, $medium->{end}) =
			     $urpm->parse_hdlist("$urpm->{cachedir}/partial/$medium->{hdlist}", 1) };
		    if (defined $medium->{start} && defined $medium->{end}) {
			delete $medium->{synthesis};
		    } else {
			$urpm->{log}(N("examining synthesis file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}"));
			eval { ($medium->{start}, $medium->{end}) =
				 $urpm->parse_synthesis("$urpm->{cachedir}/partial/$medium->{hdlist}") };
			defined $medium->{start} && defined $medium->{end} and $medium->{synthesis} = 1;
		    }
		} else {
		    $urpm->{log}(N("examining synthesis file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}"));
		    eval { ($medium->{start}, $medium->{end}) =
			     $urpm->parse_synthesis("$urpm->{cachedir}/partial/$medium->{hdlist}") };
		    if (defined $medium->{start} && defined $medium->{end}) {
			$medium->{synthesis} = 1;
		    } else {
			$urpm->{log}(N("examining hdlist file [%s]", "$urpm->{cachedir}/partial/$medium->{hdlist}"));
			eval { ($medium->{start}, $medium->{end}) =
				 $urpm->parse_hdlist("$urpm->{cachedir}/partial/$medium->{hdlist}", 1) };
			defined $medium->{start} && defined $medium->{end} and delete $medium->{synthesis};
		    }
		}
		unless (defined $medium->{start} && defined $medium->{end}) {
		    $error = 1;
		    $urpm->{error}(N("unable to parse hdlist file of \"%s\"", $medium->{name}));
		    $options{callback} && $options{callback}('failed', $medium->{name});
		    #- we will have to read back the current synthesis file unmodified.
		} else {
		    $options{callback} && $options{callback}('done', $medium->{name});
		}

		unless ($error) {
		    my @unresolved_after = grep { ! defined $urpm->{provides}{$_} } keys %{$urpm->{provides} || {}};
		    @unresolved_before == @unresolved_after or $urpm->{second_pass} = 1;

		    if ($medium->{hdlist} ne 'list' && -s "$urpm->{cachedir}/partial/list") {
			local (*F, $_);
			open F, "$urpm->{cachedir}/partial/list";
			while (<F>) {
			    /\/([^\/]*\.rpm)$/ or next;
			    $list{$1} and $urpm->{error}(N("file [%s] already used in the same medium \"%s\"", $1, $medium->{name})), next;
			    $list{$1} = "$medium->{url}/$_";
			}
			close F;
		    } else {
			#- if url is clear and no relative list file has been downloaded,
			#- there is no need for a list file.
			if ($medium->{url} ne $medium->{clear_url}) {
			    foreach ($medium->{start} .. $medium->{end}) {
				my $filename = $urpm->{depslist}[$_]->filename;
				$list{$filename} = "$medium->{url}/$filename\n";
			    }
			}
		    }
		}
	    }

	    unless ($error) {
		if (%list) {
		    #- write list file.
		    local *LIST;
		    my $mask = umask 077;
		    open LIST, ">$urpm->{cachedir}/partial/$medium->{list}"
		      or $error = 1, $urpm->{error}(N("unable to write list file of \"%s\"", $medium->{name}));
		    umask $mask;
		    print LIST values %list;
		    close LIST;

		    #- check if at least something has been written into list file.
		    if (-s "$urpm->{cachedir}/partial/$medium->{list}") {
			$urpm->{log}(N("writing list file for medium \"%s\"", $medium->{name}));
		    } else {
			$error = 1, $urpm->{error}(N("nothing written in list file for \"%s\"", $medium->{name}));
		    }
		} else {
		    #- the flag is no more necessary.
		    delete $medium->{list};
		    unlink "$urpm->{statedir}/$medium->{list}";
		}
	    }
	}

	unless ($error) {
	    #- now... on pubkey
	    if (-s "$urpm->{cachedir}/partial/pubkey") {
		$urpm->{log}(N("examining pubkey file of \"%s\"...", $medium->{name}));
		my %key_ids;
		$urpm->import_needed_pubkeys([ $urpm->parse_armored_file("$urpm->{cachedir}/partial/pubkey") ],
					     root => $urpm->{root}, callback => sub {
						 my (undef, undef, $k, $id, $imported) = @_;
						 if ($id) {
						     $key_ids{$id} = undef;
						     $imported and $urpm->{log}(N("...imported key %s from pubkey file of \"%s\"",
										  $id, $medium->{name}));
						 } else {
						     $urpm->{error}(N("unable to import pubkey file of \"%s\"", $medium->{name}));
						 }
					     });
		keys(%key_ids) and $medium->{'key-ids'} = join ',', keys %key_ids;
	    }
	}

	if ($error) {
	    #- an error has occured for updating the medium, we have to remove tempory files.
	    unlink "$urpm->{cachedir}/partial/$medium->{hdlist}";
	    $medium->{list} and unlink "$urpm->{cachedir}/partial/$medium->{list}";
	    #- read default synthesis (we have to make sure nothing get out of depslist).
	    $urpm->{log}(N("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
	    eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}") };
	    unless (defined $medium->{start} && defined $medium->{end}) {
		$urpm->{error}(N("problem reading synthesis file of medium \"%s\"", $medium->{name}));
		$medium->{ignore} = 1;
	    }
	} else {
	    #- make sure to rebuild base files and clean medium modified state.
	    $medium->{modified} = 0;
	    $urpm->{modified} = 1;

	    #- but use newly created file.
	    unlink "$urpm->{statedir}/$medium->{hdlist}";
	    $medium->{synthesis} and unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
	    $medium->{list} and unlink "$urpm->{statedir}/$medium->{list}";
	    unless ($medium->{headers}) {
		unlink "$urpm->{statedir}/synthesis.$medium->{hdlist}";
		unlink "$urpm->{statedir}/$medium->{hdlist}";
		rename("$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ?
		       "$urpm->{statedir}/synthesis.$medium->{hdlist}" : "$urpm->{statedir}/$medium->{hdlist}") or
			 system("mv", "$urpm->{cachedir}/partial/$medium->{hdlist}", $medium->{synthesis} ?
				"$urpm->{statedir}/synthesis.$medium->{hdlist}" :
				"$urpm->{statedir}/$medium->{hdlist}");
	    }
	    if ($medium->{list}) {
		rename("$urpm->{cachedir}/partial/$medium->{list}", "$urpm->{statedir}/$medium->{list}") or
		  system("mv", "$urpm->{cachedir}/partial/$medium->{list}", "$urpm->{statedir}/$medium->{list}");
	    }
	    $medium->{md5sum} = $retrieved_md5sum; #- anyway, keep it, the previous one is no more usefull.

	    #- and create synthesis file associated.
	    $medium->{modified_synthesis} = !$medium->{synthesis};
	}
    }

    #- some unresolved provides may force to rebuild all synthesis,
    #- a second pass will be necessary.
    if ($urpm->{second_pass}) {
	$urpm->{log}(N("performing second pass to compute dependencies\n"));
	$urpm->unresolved_provides_clean;
    }

    #- second pass consist of reading again synthesis or hdlist.
    foreach my $medium (@{$urpm->{media}}) {
	#- take care of modified medium only or all if all have to be recomputed.
	$medium->{ignore} and next;

	$options{callback} && $options{callback}('parse', $medium->{name});
	#- a modified medium is an invalid medium, we have to read back the previous hdlist
	#- or synthesis which has not been modified by first pass above.
	if ($medium->{headers} && !$medium->{modified}) {
	    if ($urpm->{second_pass}) {
		$urpm->{log}(N("reading headers from medium \"%s\"", $medium->{name}));
		($medium->{start}, $medium->{end}) = $urpm->parse_headers(dir     => "$urpm->{cachedir}/headers",
									  headers => $medium->{headers},
									 );
	    }
	    $urpm->{log}(N("building hdlist [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
	    #- finish building operation of hdlist.
	    $urpm->build_hdlist(start  => $medium->{start},
				end    => $medium->{end},
				dir    => "$urpm->{cachedir}/headers",
				hdlist => "$urpm->{statedir}/$medium->{hdlist}",
			       );
	    #- synthesis need to be created for sure, since the medium has been built from rpm files.
	    $urpm->build_synthesis(start     => $medium->{start},
				   end       => $medium->{end},
				   synthesis => "$urpm->{statedir}/synthesis.$medium->{hdlist}",
				  );
	    $urpm->{log}(N("built hdlist synthesis file for medium \"%s\"", $medium->{name}));
	    #- keep in mind we have modified database, sure at this point.
	    $urpm->{modified} = 1;
	} elsif ($medium->{synthesis}) {
	    if ($urpm->{second_pass}) {
		if ($medium->{virtual}) {
		    my ($path) = $medium->{url} =~ /^file:\/*(\/[^\/].*[^\/])\/*$/;
		    my $with_hdlist_file = "$path/$medium->{with_hdlist}";
		    if ($path) {
			$urpm->{log}(N("examining synthesis file [%s]", $with_hdlist_file));
			eval { ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis($with_hdlist_file) };
		    }
		} else {
		    $urpm->{log}(N("examining synthesis file [%s]", "$urpm->{statedir}/synthesis.$medium->{hdlist}"));
		    ($medium->{start}, $medium->{end}) = $urpm->parse_synthesis("$urpm->{statedir}/synthesis.$medium->{hdlist}");
		}
	    }
	} else {
	    if ($urpm->{second_pass}) {
		$urpm->{log}(N("examining hdlist file [%s]", "$urpm->{statedir}/$medium->{hdlist}"));
		($medium->{start}, $medium->{end}) = $urpm->parse_hdlist("$urpm->{statedir}/$medium->{hdlist}", 1);
	    }
	    #- check if synthesis file can be built.
	    if (($urpm->{second_pass} || $medium->{modified_synthesis}) && !$medium->{modified}) {
		unless ($medium->{virtual}) {
		    $urpm->build_synthesis(start     => $medium->{start},
					   end       => $medium->{end},
					   synthesis => "$urpm->{statedir}/synthesis.$medium->{hdlist}",
					  );
		    $urpm->{log}(N("built hdlist synthesis file for medium \"%s\"", $medium->{name}));
		}
		#- keep in mind we have modified database, sure at this point.
		$urpm->{modified} = 1;
	    }
	}
	$options{callback} && $options{callback}('done', $medium->{name});
    }

    #- clean headers cache directory to remove everything that is no more
    #- usefull according to depslist used.
    if ($urpm->{modified}) {
	if ($options{noclean}) {
	    local (*D, $_);
	    my %headers;
	    opendir D, "$urpm->{cachedir}/headers";
	    while (defined($_ = readdir D)) {
		/^([^\/]*-[^-]*-[^-]*\.[^\.]*)(?::\S*)?$/ and $headers{$1} = $_;
	    }
	    closedir D;
	    $urpm->{log}(N("found %d headers in cache", scalar(keys %headers)));
	    foreach (@{$urpm->{depslist}}) {
		delete $headers{$_->fullname};
	    }
	    $urpm->{log}(N("removing %d obsolete headers in cache", scalar(keys %headers)));
	    foreach (values %headers) {
		unlink "$urpm->{cachedir}/headers/$_";
	    }
	}

	#- this file is written in any cases.
	$urpm->write_config();
    }

    $options{nolock} or $urpm->unlock_urpmi_db;
    $options{nopubkey} or $urpm->unlock_rpm_db;
}

#- clean params and depslist computation zone.
sub clean {
    my ($urpm) = @_;

    $urpm->{depslist} = [];
    $urpm->{provides} = {};

    foreach (@{$urpm->{media} || []}) {
	delete $_->{start};
	delete $_->{end};
    }
}

#- check if supermount is used.
sub is_using_supermount {
    my ($urpm, $device_mntpoint) = @_;
    local (*F, $_);

    #- read /etc/fstab and check for existing mount point.
    open F, "/etc/fstab";
    while (<F>) {
	my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next;
	$mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,;
	if ($fstype eq 'supermount') {
	    $device_mntpoint eq $mntpoint and return 1;
	    $options =~ /^(?:.*[\s,])?dev=([^\s,]+)/ && $device_mntpoint eq $1 and return 1;
	}
    }
    return 0;
}

#- find used mount point from a pathname, use a optional mode to allow
#- filtering according the next operation (mount or umount).
sub find_mntpoints {
    my ($urpm, $dir, $infos) = @_;
    my ($pdir, $v, %fstab, @mntpoints);
    local (*F, $_);

    #- read /etc/fstab and check for existing mount point.
    open F, "/etc/fstab";
    while (<F>) {
	my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next;
	$mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,;
	$fstab{$mntpoint} =  0;
	if (ref($infos)) {
	    if ($fstype eq 'supermount') {
		$options =~ /^(?:.*[\s,])?dev=([^\s,]+)/ and $infos->{$mntpoint} = { mounted => 0, device => $1, fs => $fstype,
										     supermount => 1, };
	    } else {
		$infos->{$mntpoint} = { mounted => 0, device => $device, fs => $fstype };
	    }
	}
    }
    open F, "/etc/mtab";
    while (<F>) {
	my ($device, $mntpoint, $fstype, $options) = /^\s*(\S+)\s+(\/\S+)\s+(\S+)\s+(\S+)/ or next;
	$mntpoint =~ s,/+,/,g; $mntpoint =~ s,/$,,;
	$fstab{$mntpoint} = 1;
	if (ref($infos)) {
	    if ($fstype eq 'supermount') {
		$options =~ /^(?:.*[\s,])?dev=([^\s,]+)/ and $infos->{$mntpoint} = { mounted => 1, device => $1, fs => $fstype,
										     supermount => 1, };
	    } else {
		$infos->{$mntpoint} = { mounted => 1, device => $device, fs => $fstype };
	    }
	}
    }
    close F;

    #- try to follow symlink, too complex symlink graph may not be seen.
    #- check the possible mount point.
    my @paths = split '/', $dir;
    while (defined ($_ = shift @paths)) {
	length($_) or next;
	$pdir .= "/$_";
	$pdir =~ s,/+,/,g; $pdir =~ s,/$,,;
	if (exists($fstab{$pdir})) {
	    ref($infos) and push @mntpoints, $pdir;
	    $infos eq 'mount' && ! $fstab{$pdir} and push @mntpoints, $pdir;
	    $infos eq 'umount' && $fstab{$pdir} and unshift @mntpoints, $pdir;
	    #- following symlinks may be dangerous for supermounted device and
	    #- unusefull.
	    #- this means it is assumed no symlink inside a removable device
	    #- will go outside the device itself (or at least will go into
	    #- regular already mounted device like /).
	    #- for simplification we refuse also any other device and
	    #- stop here.
	    last;
	} elsif (-l $pdir) {
	    while ($v = readlink $pdir) {
		if ($pdir =~ /^\//) {
		    $pdir = $v;
		} else {
		    while ($v =~ /^\.\.\/(.*)/) {
			$v = $1;
			$pdir =~ s/^(.*)\/[^\/]+\/*/$1/;
		    }
		    $pdir .= "/$v";
		}
	    }
	    unshift @paths, split '/', $pdir;
	    $pdir = '';
	}
    }

    @mntpoints;
}

#- reduce pathname by removing <something>/.. each time it appears (or . too).
sub reduce_pathname {
    my ($url) = @_;

    #- clean url to remove any macro (which cannot be solved now).
    #- take care if this is a true url and not a simple pathname.
    my ($host, $dir) = $url =~ /([^:\/]*:\/\/[^\/]*\/)?(.*)/;

    #- remove any multiple /s or trailing /.
    #- then split all components of pathname.
    $dir =~ s/\/+/\//g; $dir =~ s/\/$//;
    my @paths = split '/', $dir;

    #- reset $dir, recompose it, and clean trailing / added by algorithm.
    $dir = '';
    foreach (@paths) {
	if ($_ eq '..') {
	    $dir =~ s/([^\/]+)\/$// or $dir .= "../";
	} elsif ($_ ne '.') {
	    $dir .= "$_/";
	}
    }
    $dir =~ s/\/$//;

    $host . $dir;
}

#- check for necessity of mounting some directory to get access
sub try_mounting {
    my ($urpm, $dir, $removable) = @_;
    my %infos;

    $dir = reduce_pathname($dir);
    foreach (grep { ! $infos{$_}{mounted} && $infos{$_}{fs} ne 'supermount' } $urpm->find_mntpoints($dir, \%infos)) {
	$urpm->{log}(N("mounting %s", $_));
	`mount '$_' 2>/dev/null`;
	$removable && $infos{$_}{fs} ne 'supermount' and $urpm->{removable_mounted}{$_} = undef;
    }
    -e $dir;
}

sub try_umounting {
    my ($urpm, $dir) = @_;
    my %infos;

    $dir = reduce_pathname($dir);
    foreach (reverse grep { $infos{$_}{mounted} && $infos{$_}{fs} ne 'supermount' } $urpm->find_mntpoints($dir, \%infos)) {
	$urpm->{log}(N("unmounting %s", $_));
	`umount '$_' 2>/dev/null`;
	delete $urpm->{removable_mounted}{$_};
    }
    ! -e $dir;
}

sub try_umounting_removables {
    my ($urpm) = @_;
    foreach (keys %{$urpm->{removable_mounted}}) {
	$urpm->try_umounting($_);
    }
    delete $urpm->{removable_mounted};
}

#- relocate depslist array id to use only the most recent packages,
#- reorder info hashes to give only access to best packages.
sub relocate_depslist_provides {
    my ($urpm, %options) = @_;
    my $relocated_entries = $urpm->relocate_depslist;

    $urpm->{log}($relocated_entries ?
		 N("relocated %s entries in depslist", $relocated_entries) :
		 N("no entries relocated in depslist"));
    $relocated_entries;
}

#- register local packages for being installed, keep track of source.
sub register_rpms {
    my ($urpm, @files) = @_;
    my ($start, $id, $error, %requested);

    #- examine each rpm and build the depslist for them using current
    #- depslist and provides environment.
    $start = @{$urpm->{depslist}};
    foreach (@files) {
	/\.rpm$/ or $error = 1, $urpm->{error}(N("invalid rpm file name [%s]", $_)), next;

	#- allow url to be given.
	if (my ($basename) = /^[^:]*:\/.*\/([^\/]*\.rpm)$/) {
	    unlink "$urpm->{cachedir}/partial/$basename";
	    eval {
		$urpm->{log}(N("retrieving rpm file [%s] ...", $_));
		$urpm->{sync}({ dir => "$urpm->{cachedir}/partial", quiet => 1, proxy => $urpm->{proxy} }, $_);
		$urpm->{log}(N("...retrieving done"));
		$_ = "$urpm->{cachedir}/partial/$basename";
	    };
	    $@ and $urpm->{log}(N("...retrieving failed: %s", $@));
	} else {
	    -r $_ or $error = 1, $urpm->{error}(N("unable to access rpm file [%s]", $_)), next;
	}

	($id, undef) = $urpm->parse_rpm($_);
	my $pkg = defined $id && $urpm->{depslist}[$id];
	$pkg or $urpm->{error}(N("unable to register rpm file")), next;
	$urpm->{source}{$id} = $_;
    }
    $error and $urpm->{fatal}(2, N("error registering local packages"));
    defined $id && $start <= $id and @requested{($start .. $id)} = (1) x ($id-$start+1);

    #- distribute local packages to distant nodes directly in cache of each machine.
    @files && $urpm->{parallel_handler} and $urpm->{parallel_handler}->parallel_register_rpms(@_);

    %requested;
}

#- search packages registered by their name by storing their id into packages hash.
sub search_packages {
    my ($urpm, $packages, $names, %options) = @_;
    my (%exact, %exact_a, %exact_ra, %found, %foundi);

    foreach my $v (@$names) {
	my $qv = quotemeta $v;

	unless ($options{fuzzy}) {
	    #- try to search through provides.
	    if (my @l = map { $_ && ($options{src} ? $_->arch eq 'src' : $_->is_arch_compat) &&
				($options{use_provides} || $_->name eq $v) && defined $_->id ?
				  ($_) : @{[]} } map { $urpm->{depslist}[$_] }
		keys %{$urpm->{provides}{$v} || {}}) {
		#- we assume that if the there is at least one package providing the resource exactly,
		#- this should be the best ones that is described.
		#- but we first check if one of the packages has the same name as searched.
		if (my @l2 = grep { $_->name eq $v} @l) {
		    $exact{$v} = join '|', map { $_->id } @l2;
		} else {
		    $exact{$v} = join '|', map { $_->id } @l;
		}
		next;
	    }
	}

	if ($options{use_provides} && $options{fuzzy}) {
	    foreach (keys %{$urpm->{provides}}) {
		#- search through provides to find if a provide match this one.
		#- but manages choices correctly (as a provides may be virtual or
		#- multiply defined.
		if (/$qv/) {
		    my @list = grep { defined $_ }
		      map { my $pkg = $urpm->{depslist}[$_];
			    $pkg && ($options{src} ? $pkg->arch eq 'src' : $pkg->arch ne 'src') ? $pkg->id : undef }
			keys %{$urpm->{provides}{$_} || {}};
		    @list > 0 and push @{$found{$v}}, join '|', @list;
		}
		if (/$qv/i) {
		    my @list = grep { defined $_ }
		      map { my $pkg = $urpm->{depslist}[$_];
			    $pkg && ($options{src} ? $pkg->arch eq 'src' : $pkg->arch ne 'src') ? $pkg->id : undef }
			keys %{$urpm->{provides}{$_} || {}};
		    @list > 0 and push @{$found{$v}}, join '|', @list;
		}
	    }
	}

	foreach my $id (0 .. $#{$urpm->{depslist}}) {
	    my $pkg = $urpm->{depslist}[$id];

	    ($options{src} ? $pkg->arch eq 'src' : $pkg->is_arch_compat) or next;

	    my $pack_ra = $pkg->name . '-' . $pkg->version;
	    my $pack_a = "$pack_ra-" . $pkg->release;
	    my $pack = "$pack_a." . $pkg->arch;

	    unless ($options{fuzzy}) {
		if ($pack eq $v) {
		    $exact{$v} = $id;
		    next;
		} elsif ($pack_a eq $v) {
		    push @{$exact_a{$v}}, $id;
		    next;
		} elsif ($pack_ra eq $v) {
		    push @{$exact_ra{$v}}, $id;
		    next;
		}
	    }

	    $pack =~ /$qv/ and push @{$found{$v}}, $id;
	    $pack =~ /$qv/i and push @{$foundi{$v}}, $id;
	}
    }

    my $result = 1;
    foreach (@$names) {
	if (defined $exact{$_}) {
	    $packages->{$exact{$_}} = 1;
	    foreach (split '\|', $exact{$_}) {
		my $pkg = $urpm->{depslist}[$_] or next;
		$pkg->set_flag_skip(0); #- reset skip flag as manually selected.
	    }
	} else {
	    #- at this level, we need to search the best package given for a given name,
	    #- always prefer already found package.
	    my %l;
	    foreach (@{$exact_a{$_} || $exact_ra{$_} || $found{$_} || $foundi{$_} || []}) {
		my $pkg = $urpm->{depslist}[$_];
		push @{$l{$pkg->name}}, $pkg;
	    }
	    if (values(%l) == 0) {
		$urpm->{error}(N("no package named %s", $_));
		$result = 0;
	    } elsif (values(%l) > 1 && !$options{all}) {
		$urpm->{error}(N("The following packages contain %s: %s", $_, "\n".join("\n", sort { $a cmp $b } keys %l)));
		$result = 0;
	    } else {
		foreach (values %l) {
		    my $best;
		    foreach (@$_) {
			if ($best && $best != $_) {
			    $_->compare_pkg($best) > 0 and $best = $_;
			} else {
			    $best = $_;
			}
		    }
		    $packages->{$best->id} = 1;
		    $best->set_flag_skip(0); #- reset skip flag as manually selected.
		}
	    }
	}
    }

    #- return true if no error have been encoutered, else false.
    $result;
}

#- do the resolution of dependencies.
sub resolve_dependencies {
    my ($urpm, $state, $requested, %options) = @_;

    if ($options{install_src}) {
	#- only src will be installed, so only update $state->{selected} according
	#- to src status of files.
	foreach (%$requested) {
	    my $pkg = $urpm->{depslist}[$_] or next;
	    $pkg->arch eq 'src' or next;
	    $state->{selected}{$_} = undef;
	}
    }
    if ($urpm->{parallel_handler}) {
	#- build the global synthesis file first.
	my $file = "$urpm->{cachedir}/partial/parallel.cz";
	unlink $file;
	foreach (@{$urpm->{media}}) {
	    defined $_->{start} && defined $_->{end} or next;
	    system "cat '$urpm->{statedir}/synthesis.$_->{hdlist}' >> $file";
	}
	#- let each node determine what is requested, according to handler given.
	$urpm->{parallel_handler}->parallel_resolve_dependencies($file, @_);
    } else {
	my $db;

	if ($options{rpmdb}) {
	    $db = new URPM;
	    $db->parse_synthesis($options{rpmdb});
	} else {
	    $db = URPM::DB::open($urpm->{root});
	    $db or $urpm->{fatal}(9, N("unable to open rpmdb"));
	}

	my $sig_handler = sub { undef $db; exit 3 };
	local $SIG{INT} = $sig_handler;
	local $SIG{QUIT} = $sig_handler;

	#- auto select package for upgrading the distribution.
	$options{auto_select} and $urpm->request_packages_to_upgrade($db, $state, $requested, requested => undef);

	$urpm->resolve_requested($db, $state, $requested, %options);
    }
}

sub create_transaction {
    my ($urpm, $state, %options) = @_;

    if ($urpm->{parallel_handler} || !$options{split_length} || $options{nodeps} ||
	keys %{$state->{selected}} < $options{split_level}) {
	#- build simplest transaction (no split).
	$urpm->build_transaction_set(undef, $state, split_length => 0);
    } else {
	my $db;

	if ($options{rpmdb}) {
	    $db = new URPM;
	    $db->parse_synthesis($options{rpmdb});
	} else {
	    $db = URPM::DB::open($urpm->{root});
	    $db or $urpm->{fatal}(9, N("unable to open rpmdb"));
	}

	my $sig_handler = sub { undef $db; exit 3 };
	local $SIG{INT} = $sig_handler;
	local $SIG{QUIT} = $sig_handler;

	#- build transaction set...
	$urpm->build_transaction_set($db, $state, split_length => $options{split_length});
    }
}

#- get list of package that should not be upgraded.
sub get_packages_list {
    my ($urpm, $file, $extra) = @_;
    my %val;

    local ($_, *F);
    open F, $file;
    while (<F>) {
	chomp; s/#.*$//; s/^\s*//; s/\s*$//;
	if (my ($n, $s) = /^([^\s\[]+)(?:\[\*\])?\[?\s*([^\s\]]*\s*[^\s\]]*)/) {
 	    $val{$n}{$s} = undef;
	}
    }
    close F;

    #- additional skipping from given parameter.
    foreach (split ',', $extra) {
	if (my ($n, $s) = /^([^\s\[]+)(?:\[\*\])?\[?\s*([^\s\]]*\s*[^\s\]]*)/) {
 	    $val{$n}{$s} = undef;
	}
    }

    \%val;
}
#- for compability...
sub get_unwanted_packages {
    my ($urpm, $skip) = @_;
    print STDERR "calling obsoleted method urpm::get_unwanted_packages\n";
    get_packages_list($urpm->{skiplist}, $skip);
}

#- select source for package selected.
#- according to keys given in the packages hash.
#- return a list of list containing the source description for each rpm,
#- match exactly the number of medium registered, ignored medium always
#- have a null list.
sub get_source_packages {
    my ($urpm, $packages, %options) = @_;
    my ($id, $error, %protected_files, %local_sources, @list, %fullname2id, %file2fullnames, %examined);
    local (*D, *F, $_);

    #- build association hash to retrieve id and examine all list files.
    foreach (keys %$packages) {
	my $p = $urpm->{depslist}[$_];
	if ($urpm->{source}{$_}) {
	    $protected_files{$local_sources{$_} = $urpm->{source}{$_}} = undef;
	} else {
	    $fullname2id{$p->fullname} = $_.'';
	}
    }

    #- examine each medium to search for packages.
    #- now get rpm file name in hdlist to match list file.
    foreach my $pkg (@{$urpm->{depslist} || []}) {
	$file2fullnames{$pkg->filename}{$pkg->fullname} = undef;
    }

    #- examine the local repository, which is trusted (no gpg or pgp signature check but md5 is now done).
    opendir D, "$urpm->{cachedir}/rpms";
    while (defined($_ = readdir D)) {
	if (my ($filename) = /^([^\/]*\.rpm)$/) {
	    my $filepath = "$urpm->{cachedir}/rpms/$filename";
	    if (!$options{clean_all} && -s $filepath) {
		if (keys(%{$file2fullnames{$filename} || {}}) > 1) {
		    $urpm->{error}(N("there are multiple packages with the same rpm filename \"%s\""), $filename);
		    next;
		} elsif (keys(%{$file2fullnames{$filename} || {}}) == 1) {
		    my ($fullname) = keys(%{$file2fullnames{$filename} || {}});
		    if (defined($id = delete $fullname2id{$fullname})) {
			$local_sources{$id} = $filepath;
		    } else {
			$options{clean_other} && ! exists $protected_files{$filepath} and unlink $filepath;
		    }
		} else {
		    $options{clean_other} && ! exists $protected_files{$filepath} and unlink $filepath;
		}
	    } else {
		#- this file should be removed or is already empty.
		unlink $filepath;
	    }
	} #- no error on unknown filename located in cache (because .listing) inherited from old urpmi
    }
    closedir D;

    #- clean download directory, do it here even if this is not the best moment.
    if ($options{clean_all}) {
	system("rm", "-rf", "$urpm->{cachedir}/partial");
	mkdir "$urpm->{cachedir}/partial";
    }

    foreach my $medium (@{$urpm->{media} || []}) {
	my (%sources, %list_examined, $list_warning);

	if (defined $medium->{start} && defined $medium->{end} && !$medium->{ignore}) {
	    #- always prefer a list file is available.
	    if ($medium->{list} && -r "$urpm->{statedir}/$medium->{list}") {
		open F, "$urpm->{statedir}/$medium->{list}";
		while (<F>) {
		    if (my ($filename) = /\/([^\/]*\.rpm)$/) {
			if (keys(%{$file2fullnames{$filename} || {}}) > 1) {
			    $urpm->{error}(N("there are multiple packages with the same rpm filename \"%s\""), $filename);
			    next;
			} elsif (keys(%{$file2fullnames{$filename} || {}}) == 1) {
			    my ($fullname) = keys(%{$file2fullnames{$filename} || {}});
			    defined($id = $fullname2id{$fullname}) and $sources{$id} = $_;
			    $list_examined{$fullname} = $examined{$fullname} = undef;
			}
		    } else {
			chomp;
			$error = 1;
			$urpm->{error}(N("unable to correctly parse [%s] on value \"%s\"",
					 "$urpm->{statedir}/$medium->{list}", $_));
			last;
		    }
		}
		close F;
	    }
	    if (defined $medium->{url}) {
		foreach ($medium->{start} .. $medium->{end}) {
		    my $pkg = $urpm->{depslist}[$_];
		    if (keys(%{$file2fullnames{$pkg->filename} || {}}) > 1) {
			$urpm->{error}(N("there are multiple packages with the same rpm filename \"%s\""), $pkg->filename);
			next;
		    } elsif (keys(%{$file2fullnames{$pkg->filename} || {}}) == 1) {
			my ($fullname) = keys(%{$file2fullnames{$pkg->filename} || {}});
			unless (exists($list_examined{$fullname})) {
			    ++$list_warning;
			    defined($id = $fullname2id{$fullname}) and $sources{$id} = "$medium->{url}/".$pkg->filename;
			    $examined{$fullname} = undef;
			}
		    }
		}
		$list_warning && $medium->{list} && -r "$urpm->{statedir}/$medium->{list}" and
		  $urpm->{error}(N("medium \"%s\" uses an invalid list file:
  mirror is probably not up-to-date, trying to use alternate method", $medium->{name}));
	    } elsif (!%list_examined) {
		$error = 1;
		$urpm->{error}(N("medium \"%s\" does not define any location for rpm files", $medium->{name}));
	    }
	}
	push @list, \%sources;
    }

    #- examine package list to see if a package has not been found.
    foreach (grep { ! exists($examined{$_}) } keys %fullname2id) {
	$error = 1;
	$urpm->{error}(N("package %s is not found.", $_));
    }

    $error ? @{[]} : (\%local_sources, \@list);
}

#- download package that may need to be downloaded.
#- make sure header are available in the appropriate directory.
#- change location to find the right package in the local
#- filesystem for only one transaction.
#- try to mount/eject removable media here.
#- return a list of package ready for rpm.
sub download_source_packages {
    my ($urpm, $local_sources, $list, %options) = @_;
    my %sources = %$local_sources;
    my %error_sources;

    print STDERR "calling obsoleted method urpm::download_source_packages\n";

    $urpm->exlock_urpmi_db;
    $urpm->copy_packages_of_removable_media($list, \%sources, %options) or return;
    $urpm->download_packages_of_distant_media($list, \%sources, \%error_sources, %options);
    $urpm->unlock_urpmi_db;

    %sources, %error_sources;
}

#- safety rpm db locking mechanism
sub exlock_rpm_db {
    my ($urpm) = @_;

    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
    my ($LOCK_EX, $LOCK_NB) = (2, 4);

    #- lock urpmi database, but keep lock to wait for an urpmi.update to finish.
    open RPMLOCK_FILE, ">$urpm->{statedir}/.RPMLOCK";
    flock RPMLOCK_FILE, $LOCK_EX|$LOCK_NB or $urpm->{fatal}(7, N("urpmi database locked"));
}
sub shlock_rpm_db {
    my ($urpm) = @_;

    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
    my ($LOCK_SH, $LOCK_NB) = (1, 4);

    #- create the .LOCK file if needed (and if possible)
    unless (-e "$urpm->{statedir}/.RPMLOCK") {
	open RPMLOCK_FILE, ">$urpm->{statedir}/.RPMLOCK";
	close RPMLOCK_FILE;
    }
    #- lock urpmi database, if the LOCK file doesn't exists no share lock.
    open RPMLOCK_FILE, "$urpm->{statedir}/.RPMLOCK" or return;
    flock RPMLOCK_FILE, $LOCK_SH|$LOCK_NB or $urpm->{fatal}(7, N("urpmi database locked"));
}
sub unlock_rpm_db {
    my ($urpm) = @_;

    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
    my $LOCK_UN = 8;

    #- now everything is finished.
    system("sync");

    #- release lock on database.
    flock RPMLOCK_FILE, $LOCK_UN;
    close RPMLOCK_FILE;
}

sub exlock_urpmi_db {
    my ($urpm) = @_;

    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
    my ($LOCK_EX, $LOCK_NB) = (2, 4);

    #- lock urpmi database, but keep lock to wait for an urpmi.update to finish.
    open LOCK_FILE, ">$urpm->{statedir}/.LOCK";
    flock LOCK_FILE, $LOCK_EX|$LOCK_NB or $urpm->{fatal}(7, N("urpmi database locked"));
}
sub shlock_urpmi_db {
    my ($urpm) = @_;

    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
    my ($LOCK_SH, $LOCK_NB) = (1, 4);

    #- create the .LOCK file if needed (and if possible)
    unless (-e "$urpm->{statedir}/.LOCK") {
	open LOCK_FILE, ">$urpm->{statedir}/.LOCK";
	close LOCK_FILE;
    }
    #- lock urpmi database, if the LOCK file doesn't exists no share lock.
    open LOCK_FILE, "$urpm->{statedir}/.LOCK" or return;
    flock LOCK_FILE, $LOCK_SH|$LOCK_NB or $urpm->{fatal}(7, N("urpmi database locked"));
}
sub unlock_urpmi_db {
    my ($urpm) = @_;

    #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base).
    my $LOCK_UN = 8;

    #- now everything is finished.
    system("sync");

    #- release lock on database.
    flock LOCK_FILE, $LOCK_UN;
    close LOCK_FILE;
}

sub copy_packages_of_removable_media {
    my ($urpm, $list, $sources, %options) = @_;
    my %removables;

    #- make sure everything is correct on input...
    @{$urpm->{media} || []} == @$list or return;

    #- examine if given medium is already inside a removable device.
    my $check_notfound = sub {
	my ($id, $dir, $removable) = @_;
	$dir and $urpm->try_mounting($dir, $removable);
	if (!$dir || -e $dir) {
	    foreach (values %{$list->[$id]}) {
		chomp;
		/^(removable_?[^_:]*|file):\/(.*\/([^\/]*))/ or next;
		unless ($dir) {
		    $dir = $2;
		    $urpm->try_mounting($dir, $removable);
		}
		-r $2 or return 1;
	    }
	} else {
	    return 2;
	}
	return 0;
    };
    #- removable media have to be examined to keep mounted the one that has
    #- more package than other (size is better ?).
    my $examine_removable_medium = sub {
	my ($id, $device, $copy) = @_;
	my $medium = $urpm->{media}[$id];
	if (my ($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) {
	    #- the directory given does not exist or may be accessible
	    #- by mounting some other. try to figure out these directory and
	    #- mount everything necessary.
	    while ($check_notfound->($id, $dir, 'removable')) {
		$options{ask_for_medium} or $urpm->{fatal}(4, N("medium \"%s\" is not selected", $medium->{name}));
		$urpm->try_umounting($dir); system("eject", $device);
		$options{ask_for_medium}($medium->{name}, $medium->{removable}) or
		  $urpm->{fatal}(4, N("medium \"%s\" is not selected", $medium->{name}));
	    }
	    if (-e $dir) {
		while (my ($i, $url) = each %{$list->[$id]}) {
		    print STDERR "copying or looking for $i:$url";
		    chomp $url;
		    my ($filepath, $filename) = $url =~ /^(?:removable[^:]*|file):\/(.*\/([^\/]*))/ or next;
		    if (-r $filepath) {
			if ($copy) {
			    #- we should assume a possible buggy removable device...
			    #- first copy in cache, and if the package is still good, transfert it
			    #- to the great rpms cache.
			    unlink "$urpm->{cachedir}/partial/$filename";
			    if (!system("cp", "--preserve=mode", "--preserve=timestamps", "-R",
					$filepath, "$urpm->{cachedir}/partial") &&
				URPM::verify_rpm("$urpm->{cachedir}/partial/$filename", nosignatures => 1) !~ /NOT OK/) {
				#- now we can consider the file to be fine.
				unlink "$urpm->{cachedir}/rpms/$filename";
				rename("$urpm->{cachedir}/partial/$filename", "$urpm->{cachedir}/rpms/$filename") or
				  system("mv", "$urpm->{cachedir}/partial/$filename", "$urpm->{cachedir}/rpms/$filename");
				-r "$urpm->{cachedir}/rpms/$filename" and $sources->{$i} = "$urpm->{cachedir}/rpms/$filename";
			    }
			} else {
			    $sources->{$i} = $filepath;
			}
		    }
		    unless ($sources->{$i}) {
			#- fallback to use other method for retrieving the file later.
			$urpm->{error}(N("unable to read rpm file [%s] from medium \"%s\"", $filepath, $medium->{name}));
		    }
		}
	    } else {
		$urpm->{error}(N("medium \"%s\" is not selected", $medium->{name}));
	    }
	} else {
	    #- we have a removable device that is not removable, well...
	    $urpm->{error}(N("incoherent medium \"%s\" marked removable but not really", $medium->{name}));
	}
    };

    foreach (0..$#$list) {
	values %{$list->[$_]} or next;
	my $medium = $urpm->{media}[$_];
	#- examine non removable device but that may be mounted.
	if ($medium->{removable}) {
	    push @{$removables{$medium->{removable}} ||= []}, $_;
	} elsif (my ($prefix, $dir) = $medium->{url} =~ /^(removable[^:]*|file):\/(.*)/) {
	    chomp $dir;
	    -e $dir || $urpm->try_mounting($dir) or
	      $urpm->{error}(N("unable to access medium \"%s\"", $medium->{name})), next;
	}
    }
    foreach my $device (keys %removables) {
	#- here we have only removable device.
	#- if more than one media use this device, we have to sort
	#- needed package to copy first the needed rpm files.
	if (@{$removables{$device}} > 1) {
	    my @sorted_media = sort { values %{$list->[$a]} <=> values %{$list->[$b]} } @{$removables{$device}};

	    #- check if a removable device is already mounted (and files present).
	    if (my ($already_mounted_medium) = grep { !$check_notfound->($_) } @sorted_media) {
		@sorted_media = grep { $_ ne $already_mounted_medium } @sorted_media;
		unshift @sorted_media, $already_mounted_medium;
	    }

	    #- mount all except the biggest one.
	    foreach (@sorted_media[0 .. $#sorted_media-1]) {
		$examine_removable_medium->($_, $device, 'copy');
	    }
	    #- now mount the last one...
	    $removables{$device} = [ $sorted_media[-1] ];
	}

	#- mount the removable device, only one or the important one.
	#- if supermount is used on the device, it is preferable to copy
	#- the file instead (because it is so slooooow).
	$examine_removable_medium->($removables{$device}[0], $device, $urpm->is_using_supermount($device) && 'copy');
    }

    1;
}

sub download_packages_of_distant_media {
    my ($urpm, $list, $sources, $error_sources, %options) = @_;

    #- get back all ftp and http accessible rpms file into the local cache
    #- if necessary (as used by checksig or any other reasons).
    foreach (0..$#$list) {
	my %distant_sources;

	#- ignore as well medium that contains nothing about the current set of files.
	values %{$list->[$_]} or next;

	#- examine all files to know what can be indexed on multiple media.
	while (my ($i, $url) = each %{$list->[$_]}) {
	    #- it is trusted that the url given is acceptable, so the file can safely be ignored.
	    defined $sources->{$i} and next;
	    if ($url =~ /^(removable[^:]*|file):\/(.*\.rpm)$/) {
		if (-r $2) {
		    $sources->{$i} = $2;
		} else {
		    $error_sources->{$i} = $2;
		}
	    } elsif ($url =~ /^([^:]*):\/(.*\/([^\/]*\.rpm))$/) {
		if ($options{force_local} || $1 ne 'ftp' && $1 ne 'http') { #- only ftp and http protocol supported by grpmi.
		    $distant_sources{$i} = "$1:/$2";
		} else {
		    $sources->{$i} = "$1:/$2";
		}
	    } else {
		$urpm->{error}(N("malformed input: [%s]", $url));
	    }
	}

	#- download files from the current medium.
	if (%distant_sources) {
	    eval {
		$urpm->{log}(N("retrieving rpm files from medium \"%s\"...", $urpm->{media}[$_]{name}));
		$urpm->{sync}({ dir => "$urpm->{cachedir}/partial",
				quiet => 0,
				verbose => $options{verbose},
				limit_rate => $options{limit_rate},
				compress => $options{compress},
				callback => $options{callback},
				proxy => $urpm->{proxy} },
			      values %distant_sources);
		$urpm->{log}(N("...retrieving done"));
	    };
	    if ($@) {
		$urpm->{log}(N("...retrieving failed: %s", $@));
	    }
	    #- clean files that have not been downloaded, but keep mind there
	    #- has been problem downloading them at least once, this is
	    #- necessary to keep track of failing download in order to
	    #- present the error to the user.
	    foreach my $i (keys %distant_sources) {
		my ($filename) = $distant_sources{$i} =~ /\/([^\/]*\.rpm)$/;
		if ($filename && -s "$urpm->{cachedir}/partial/$filename" &&
		    URPM::verify_rpm("$urpm->{cachedir}/partial/$filename", nosignatures => 1) !~ /NOT OK/) {
		    #- it seems the the file has been downloaded correctly and has been checked to be valid.
		    unlink "$urpm->{cachedir}/rpms/$filename";