#!/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;
     }
   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.list";

    my $fo;
    sysopen $fo, $list, O_CREAT | O_EXCL, 0600;
    print $fo "$_\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;
  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+/;
    my $N = $D[5]; # name
    my $M = $D[0]; # mode

    # 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;
}
