root/src/vfs/extfs/helpers/ualz.in

/*   */

# @PERL@
#
# Written by Pavel Roskin <proski@gnu.org>
# (C) 2005 The Free Software Foundation.
#
# Rewritten by Vadim Kalinnikov <moose@ylsoftware.com>
# (C) 2025
#
# It requires unalz v0.65. Older version may be work, but it is not tested.
 
use strict;
use warnings;
# disabled, because test harness doesn't have it
#use diagnostics;
 
# Some ideas found in file UnAlzUtils.cpp from unalz sources
# Attr from unalz output have 4 chars.
# Every chars may be:
# - - no attr
# A - Archived file
# D - Directory
# R - Read-only
# H - Hidden
sub attrToStr($) {
        my $attr_src = shift;
        if ($attr_src =~ m{D} && $attr_src =~ m{R}) {
                return "dr-xr-xr-x"
        }
        elsif ($attr_src =~ m{D}) {
                return "drwxr-xr-x"
        }
        elsif ($attr_src =~ m{R}) {
                return "-r--r--r--"
        }
        else {
                return "-rw-r--r--"
        }
}
 
sub mcalzfs_list($) {
        my $arc = shift;
 
        my $arc_list_cmd = "unalz -l \"$arc\"";
    $arc_list_cmd = $ENV{MC_TEST_EXTFS_LIST_CMD} if defined $ENV{MC_TEST_EXTFS_LIST_CMD};
 
    my @lines = `$arc_list_cmd`;
    chomp @lines;
    if ($? != 0) { exit 1; } # unalz command error (exit code != 0)
 
    my @list;
    foreach my $line (@lines) {
                if ($line =~ m{(.{4})\s+(\d+)\s+\d+ (\d{2})\.(\d{2})\.(\d{4}) (\d{2}:\d{2}):\d{2}  (.+)}) {
                        my $item = {
                                attr => attrToStr($1),
                                size => $2,
                                filename => $7,
                                ts => "$3-$4-$5 $6",
                        };
                        push @list, $item;
                }
        }
 
 
        # Set UID / GID to 0 / 0 as described in issue 4643
        foreach my $item (@list) {
                printf "%s 1 0 0 %10d %s %s\n",
                        $item->{attr},
                        $item->{size},
                        $item->{ts},
                        $item->{filename};
        }
}
 
 
sub mcalzfs_copyout($$$) {
        my $arc = shift;
        my $src = shift;
        my $dst = shift;
 
        `unalz -p "$arc" "$src" > "$dst"`;
        if ($? != 0) { exit 1; } # unalz command error (exit code != 0)
 
}
 
my $action = shift @ARGV || exit 1;
my $filename = shift @ARGV || exit 1;
 
if ($action eq "list") {
    mcalzfs_list($filename);
    exit 0;
}
elsif ($action eq "copyout") {
    my $srcfilename = shift @ARGV || exit 1;
    my $dstfilename = shift @ARGV || exit 1;
    mcalzfs_copyout($filename, $srcfilename, $dstfilename);
    exit 0;
}
elsif ($action eq "copyin") {
    print "copyin not implemented\n";
    exit 1;
}
elsif ($action eq "run") {
    print "run not implemented\n";
    exit 1;
}
elsif ($action eq "mkdir") {
    print "mkdir not implemented\n";
    exit 1;
}
elsif ($action eq "rmdir") {
    print "rmdir not implemented\n";
    exit 1;
}
elsif ($action eq "rm") {
    print "rm not implemented\n";
    exit 1;
}
 
exit 1;
 

/*   */