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
|
package urpm::util;
use strict;
use Exporter;
our @ISA = 'Exporter';
our @EXPORT = qw(quotespace unquotespace
remove_internal_name
reduce_pathname offset_pathname
md5sum untaint
);
#- quoting/unquoting a string that may be containing space chars.
sub quotespace { my $x = $_[0] || ''; $x =~ s/(\s)/\\$1/g; $x }
sub unquotespace { my $x = $_[0] || ''; $x =~ s/\\(\s)/$1/g; $x }
sub remove_internal_name { my $x = $_[0] || ''; $x =~ s/\(\S+\)$/$1/g; $x }
#- 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 =~ m|([^:/]*://[^/]*/)?(.*)|;
$host = '' if !defined $host;
#- 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 '..') {
if ($dir =~ s|([^/]+)/$||) {
if ($1 eq '..') {
$dir .= "../../";
}
} else {
$dir .= "../";
}
} elsif ($_ ne '.') {
$dir .= "$_/";
}
}
$dir =~ s|/$||;
$dir ||= '/';
$host . $dir;
}
#- offset pathname by returning the right things to add to a relative directory
#- to make no change. url is needed to resolve going before to top base.
sub offset_pathname {
my ($url, $offset) = map { reduce_pathname($_) } @_;
#- 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 (undef, $dir) = $url =~ m|([^:/]*://[^/]*/)?(.*)|;
my @paths = split '/', $dir;
my @offpaths = reverse split '/', $offset;
my @corrections;
my $result = '';
foreach (@offpaths) {
if ($_ eq '..') {
push @corrections, pop @paths;
} else {
$result .= '../';
}
}
$result . join('/', reverse @corrections);
}
sub untaint {
my @r;
foreach (@_) { /(.*)/; push @r, $1 }
@r == 1 ? $r[0] : @r;
}
sub md5sum {
#- Use an external command to avoid depending on perl
my ($file) = @_;
return((split ' ', `md5sum '$file'`)[0]);
}
sub copy {
my ($file, $dest) = @_;
!system("/bin/cp", "-p", "-L", "-R", $file, $dest);
}
sub move {
my ($file, $dest) = @_;
rename($file, $dest) or !system("/bin/mv", "-f", $file, $dest);
}
1;
__END__
|
