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
|
#!/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> http://cade.webbg.com
#
# 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;
use POSIX;
umask 0077;
my $cmd = lc shift @ARGV;
my $archive = shift @ARGV;
my $cache = "/tmp/$archive.rx.cache";
$cache =~ s/^(\/tmp\/)(.+)\/([^\/]+)$/$1$3/;
if ( $cmd eq "l" || $cmd eq "v" )
{
my $dir = shift @ARGV;
if( ! -e $cache )
{
# cache not found--fill it
system( qq[ umask 0077; tar tvf "$archive" > "$cache" ] ) if $archive =~ /\.tar$/i;
system( qq[ umask 0077; gzip -dc "$archive" | tar tvf - > "$cache" ] ) if $archive =~ /\.tar\.g?z(\.rx\.cache)?$/i;
system( qq[ umask 0077; gzip -dc "$archive" | tar tvf - > "$cache" ] ) if $archive =~ /\.tgz$/i;
system( qq[ umask 0077; xz -dc "$archive" | tar tvf - > "$cache" ] ) if $archive =~ /(\.txz|\.tar\.xz(\.rx\.cache)?)$/i;
system( qq[ umask 0077; bzip2 -dc "$archive" | tar tvf - > "$cache" ] ) if $archive =~ /\.tar\.bz2?$/i;
system( qq[ umask 0077; zstd -dc "$archive" | tar tvf - > "$cache" ] ) if $archive =~ /\.tar\.zst$/i;
}
else
{
utime time(), time(), $cache; # update last modification time of the cache
}
my $content = read_archive( $cache );
# use Data::Dumper;
# print Dumper( $content );
if ( $cmd eq "l" )
{
$dir .= "/" unless $dir =~ /\/$/;
}
else
{
$dir = '*';
}
exit unless exists $content->{ $dir };
for my $e ( keys %{ $content->{ $dir } } )
{
my %E = %{ $content->{ $dir }{ $e } };
print "NAME:$E{ NAME }\nSIZE:$E{ SIZE }\nMODE:$E{ MODE }\nTIME:$E{ TIME }\n\n";
}
}
elsif ( $cmd eq "x" )
{
my $list;
if ( $ARGV[0] =~ /^\@(.+)$/ )
{
$list = $1;
}
else
{
$list = "/tmp/rx.$$.rxlist";
sysopen my $fo, $list, O_CREAT | O_EXCL | O_RDWR, 0600;
print $fo "$_\n" for @ARGV;
print STDERR "[$_]\n" for @ARGV;
close $fo;
}
system( qq[ tar xvf "$archive" -T "$list" ] ) if $archive =~ /\.tar$/i;
system( qq[ gzip -dc "$archive" | tar xvf - -T "$list" ] ) if $archive =~ /\.tar\.g?z(\.rx\.cache)?$/i;
system( qq[ gzip -dc "$archive" | tar xvf - -T "$list" ] ) if $archive =~ /\.tgz$/i;
system( qq[ xz -dc "$archive" | tar xvf - -T "$list" ] ) if $archive =~ /\.tar\.xz(\.rx\.cache)?$/i;
system( qq[ xz -dc "$archive" | tar xvf - -T "$list" ] ) if $archive =~ /\.txz$/i;
system( qq[ bzip2 -dc "$archive" | tar xvf - -T "$list" ] ) if $archive =~ /\.tar\.bz2?$/i;
system( qq[ zstd -dc "$archive" | tar xvf - -T "$list" ] ) if $archive =~ /\.tar\.zst$/i;
unlink $list;
}
else
{
die $0 . ": wrong command.\n";
}
sub read_archive
{
my $cache_fn = shift;
my %C;
open( my $i, $cache_fn );
while(<$i>)
{
chop;
s/\s+->\s+\S+?$//; # no symlinks support?
my @D = split /\s+/, $_, 6;
my $N = $D[5]; # name
my $M = $D[0]; # mode
#use Data::Dumper;
#print STDERR Dumper( $_, \@D, $N );
# strip leading /s
$N =~ s/^\.\///;
$N =~ s/^\//\//;
$N =~ s/\/$//;
my $F = $N; # full name, before path split
my $P; # parent
if( $N =~ /^(.+?\/)([^\/]+)$/ )
{
$P = $1;
$N = $2;
}
my $T = "$D[3]$D[4]"; # time
$T =~ s/[\-\s\:]//g;
$T = substr( $T, 0, 12 );
my %E;
$E{ NAME } = $N;
$E{ SIZE } = $D[2];
$E{ MODE } = $M;
$E{ TIME } = $T;
$C{ $P }{ $N } = \%E;
$C{ '*' }{ $F } = { %E, NAME => $F };
}
close( $i );
# preprocessing missing dirs
for my $p ( keys %C )
{
next if $p eq '*';
$p =~ s/\/$//;
my @p = split /\//, $p;
my $path;
while( @p )
{
my $next = shift @p;
if( ! exists $C{ $path }{ $next } )
{
my %E;
$E{ NAME } = "$next/";
$E{ SIZE } = 0;
$E{ MODE } = "dr-xr-xr-x";
$E{ TIME } = "197101010000";
$C{ $path }{ $next } = \%E;
}
$path .= "$next/";
}
}
$C{ '/' } = $C{ '' };
return \%C;
}
|
