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
|
#!/usr/bin/perl
#
# rx_deb v archive directory
# rx_deb x archive files...
# rx_deb x archive @listfile
#
$command = shift @ARGV;
$archive = shift @ARGV;
if ( $command eq "v" )
{
$dir = shift @ARGV;
if ( $dir ) { $dir .= "/" unless $dir =~ /\/$/; }
if ( $dir eq "DATA/" )
{
open( i, "ar p $archive data.tar.gz | gzip -dc | tar tvf - |");
while(<i>)
{
chop;
s/\s+->\s+\S+$//;
if (/^(.[\-rwxsStT]{9})\s+\S+\s+(\d+)\s+(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d)(:\d\d)?\s+(\S+[^\/])$/)
{
print "NAME:$8\nSIZE:$2\nMODE:$1\nTIME:$3$4$5$6$7\n\n";
}
}
close( i );
}
else
{
# these are standard ones
print "NAME:control\n\nNAME:debian-binary\n\nNAME:DATA/\n\n";
# FIXME: here should take ar list and get files' sizes etc...
}
} # view command ends here
elsif ( $command eq "x" )
{
if ( $ARGV[0] eq "control" )
{
system( "ar p $archive control.tar.gz | gzip -d | tar xvf - control" );
}
elsif ( $ARGV[0] eq "debian-binary" )
{
system( "ar p $archive debian-binary > debian-binary" );
}
else
{
if ( $ARGV[0] =~ /^\@(.+)$/ )
{
$listfile = $1;
}
else
{
$listfile = "/tmp/rx_tar.list." . $$;
open( o, ">$listfile" );
while( $_ = shift @ARGV )
{
s/^DATA\///;
print o "$_\n";
}
close( o );
}
system( "mkdir -p DATA; cd DATA; ar p $archive data.tar.gz | gzip -d | tar xvf - -T $listfile" );
unlink $listfile;
}
}
|
