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
|
#!/usr/bin/perl
#############################################################################
#
# rx_* dispatcher and handlers for VFU File Manager
# Copyright (c) 2002-2020 Vladi Belperchinov-Shabanski "Cade"
# <cade@biscom.net> <cade.datamax.bg>
#
# usage:
# rx_* l archive directory # list archive directory
# rx_* v archive # list entire archive
# rx_* x archive files... # extract one file
# rx_* x archive @listfile # extract list of files
#
#############################################################################
use strict;
umask 0077;
my $cmd = lc shift @ARGV;
my $archive = shift @ARGV;
my $ac=`ar t "$archive"`;
die "unsupported DEB package\n" unless $ac =~ /(data.tar.[a-z0-9]+)/;
my $data = $1;
my $cache = "$archive.$data.rx.cache";
$cache =~ s/^(.+)\/([^\/]+)$/$2/;
if( $cmd eq "l" || $cmd eq "v" || $cmd eq "x" )
{
if( ! -e "/tmp/$cache" )
{
# cache not found--fill it
system( qq[ umask 0077 ; ar p "$archive" $data > "/tmp/$cache\" ] );
}
else
{
utime time(), time(), "/tmp/$cache"; # update last modification time of the cache
}
if( $cmd eq 'x' )
{
for( @ARGV )
{
if( /^\@(.+)/ )
{
fix_list_names( $1 );
}
else
{
s/^(?!\.\/)/.\//;
}
}
}
system( "/usr/libexec/vfu/rx_tar", $cmd, "/tmp/$cache", @ARGV );
}
else
{
die $0 . ": wrong command.\n";
}
sub fix_list_names
{
my $fn = shift; # file name
my @l = file_load_ar( $fn );
s/^(?!\.\/)/.\// for @l;
file_save( $fn, @l );
return 1;
}
sub file_load_ar
{
my $fn = shift; # file name
open( my $i, "<", $fn ) or return undef;
my @all = <$i>;
close $i;
return @all;
}
sub file_save
{
my $fn = shift; # file name
open( my $o, ">", $fn ) or return 0;
print $o @_;
close $o;
return 1;
}
|
