#!/usr/bin/perl
use strict;
use File::Copy;

# Authors:
# pre 2011 - Original author unknown, laut rdescamps irgendwann die SE
# Jun 2011 - Packaged by hkettler
# Mar 2016 - Edited by jstebens during host.1743 - removed deprecated defined(@{ $args })

my $ZIP_SUPPORT=1;
eval "use Archive::Zip";
$ZIP_SUPPORT=0 if($@);

$|=1;

my $version="1.0";

my $ACTION_ABORT="A0";
my $ACTION_SKIP="A1";
my $ACTION_RETRY="A2";
my $ACTION_EXEC="A3";
my $ACTION_ALWAYS="A4";
my $ACTION_NEVER="A5";

my $POLICY_ASK="P0";
my $POLICY_ALWAYS="P1";
my $POLICY_NEVER="P2";

my $cmd;
my %args;
my @argNames;
my @argValues;

my $procpath;
my $action;
my $policy;

$SIG{ALRM}=sub{&error_response("E8");};
alarm(120);

&read_stdin();

sub reset_proceed {
  undef($procpath);
  undef($action);
}

sub read_stdin {
  my $vread=0;
  my $cread=0;
  my $error;
  while(<>) {
    chop;
    if($_ eq "") {
      if(!$error) {
        if(!$vread) {
          $error="E1";
        } elsif(!$cread) {
          $error="E2";
        }
      }
      if($error) {
        &error_response($error);
      } else {
        &do_process($cmd,@argNames,@argValues);
      }
      $vread=0;
      $cread=0;
      $error=0;
      $cmd=0;
    }else {
      if(!$vread) {
        if($_ ne $version) {
          $error="E0";
        }
        $vread=1;
      } elsif(!$cread) {
        $cmd=$_;
        $cread=1;
      } else {
        my $ind=index($_,":");
        if($ind<1) {&error_response("E4");}
        my $argName=substr($_,0,$ind);
        my $argValue=substr($_,$ind+1);
        if(defined $args{$argName}) {
          push(@{$args{$argName}},$argValue);
        } else {
          $args{$argName}=[$argValue];
        }
        push(@argNames,$argName);
        push(@argValues,$argValue);
      }
    }
  }
}

sub error_response {
  my ($error,$val)=@_;
  print "$version\n";
  print "Error\n";
  print "E-EC:$error\n";
  if(defined($val)) {print "E-V:$val\n";}
  print "\n";
  exit 1;
}

sub done_response {
  print "$version\n";
  print "Done\n";
  print "\n";
  exit 0;
}

sub do_process {
  if($cmd eq "Copy") {
    &do_copy();
  } elsif ($cmd eq "Delete") {
    &do_delete();
  } elsif ($cmd eq "Move") {
    &do_move();
  } elsif ($cmd eq "Zip") {
    &error_response("E3",$cmd) if(!$ZIP_SUPPORT);
    &do_zip();
  } elsif ($cmd eq "Unzip") {
    &error_response("E3",$cmd) if(!$ZIP_SUPPORT);
    &do_unzip();
  } elsif ($cmd eq "Chmod") {
    &do_chmod();
  } elsif ($cmd eq "Test") {
    &do_test();
  } elsif ($cmd eq "Stat") {
    &do_stat();
  } else {
    &error_response("E3",$cmd);
  }
}

sub get_args {
  my ($argName)=@_;
  my @values;
  my $len=@argNames;
  for(my $i=0;$i<$len;$i++) {
    if($argNames[$i] eq $argName) {
      push(@values,$argValues[$i]);
    }
  }
  return @values;
}


########
# COPY #
########

sub do_copy {
  &error_response("E6","B") if(!defined $args{"B"});
  my $base=${$args{"B"}}[0];
  &error_response("E6","T") if(!defined $args{"T"});
  my $target=${$args{"T"}}[0];
  &error_response("E6","S") if(!defined $args{"S"});
  $policy=${args{"OP"}}[0] if(defined $args{"OP"});
  &failed_response("S20","F-B:$base") if(!(-d $base));
  &failed_response("S22","F-TP:$target") if(!((-l $target)||(-d $target)||(-f $target)));
  &failed_response("S31","F-TP:$target") if(!(-w $target));
  $procpath=${$args{"P-SP"}}[0] if(defined $args{"P-SP"});
  $action=${$args{"P-AC"}}[0] if(defined $args{"P-AC"});
  &error_response("E6") if((defined($procpath) && !defined($action))||(defined($action) && !defined($procpath)));
  if($procpath) {
    if($action eq $ACTION_ALWAYS) {$policy=$POLICY_ALWAYS;}
    elsif($action eq $ACTION_NEVER) {$policy=$POLICY_NEVER;}
  }
  my $len=@{$args{"S"}};
  for(my $i=0;$i<$len;$i++) {
    my $name=${$args{"S"}}[$i];
    my $spath=$base."/".$name;
    my $isproc=0;
    $isproc=($spath eq $procpath) if(defined($procpath));
    if(!(-e $spath)) {
      &do_copy_query("S21","Q-SP:$spath") if(!$isproc);
    } elsif(-l $spath) {
      &copy_symlink($name,$base,$target);
    } elsif(-d $spath) {
      &copy_dir($name,$base,$target);
    } elsif(-f $spath) {
      &copy_file($name,$base,$target);
    } else {
      &do_copy_query("S29","Q-SP:$spath") if(!$isproc);
    }
    undef(${$args{"S"}}[$i]);
  }
  &done_response();
}

sub failed_response {
  my ($sc,$src)=@_;
  print "$version\n";
  print "Failed\n";
  print "F-SC:$sc\n";
  print "$src\n";
  print "\n";
  exit 0;
}

sub do_copy_query {
  my ($sc,$src)=@_;
  print "$version\n";
  print "Query\n";
  my $base=${$args{"B"}}[0];
  print "B:$base\n";
  my @sources=@{$args{"S"}};
  foreach(@sources) {
    if(defined($_)) {
      print "S:$_\n";
    }
  }
  my $target=${$args{"T"}}[0];
  print "T:$target\n";
  if(defined($policy)) {print "OP:$policy\n";}
  print "Q-SC:$sc\n";
  print "$src\n";
  print "\n";
  exit 0;
}

sub copy_dir {
  my ($relpath,$base,$target)=@_;
  my $spath=$base."/".$relpath;
  my $tpath=$target."/".$relpath;
  my $isproc=0;
  if(defined($procpath)) {
    $isproc=($spath eq $procpath);
    if(!$isproc) {
      return if(length($spath)>length($procpath));
      return if(!($spath eq substr($procpath,0,length($spath))));
    }
  }
  if($isproc && ($action eq $ACTION_SKIP)) {
    &reset_proceed();
    return;
  }
  &copy_dir_check($spath,$tpath);
  if(!(-e $tpath)) {
    my $res=mkdir($tpath);
    if($res==0) {
      &copy_dir_check($spath,$tpath);
      &do_copy_query("S102","Q-SP:$spath");
    }
  }
  if(opendir(DH,$spath)) {
    my @contents=readdir(DH);
    closedir(DH);
    my $file;
    my @files=sort grep(!/^\.\.?$/,@contents);
    foreach $file (@files) {
      my $relfp=$relpath."/".$file;
      my $fp=$base."/".$relfp;
      if(-l $fp) {
        &copy_symlink($relfp,$base,$target);
      } elsif(-d $fp) {
        &copy_dir($relfp,$base,$target);
      } elsif(-f $fp) {
        &copy_file($relfp,$base,$target);
      }
    }
  } else {
    &do_copy_query("S90","Q-SP:$spath");
  }
}

sub copy_dir_check {
  my ($spath,$tpath)=@_;
  if(!(-r $spath)) {&do_copy_query("S25","Q-SP:$spath");}
  if(!(-x $spath)) {&do_copy_query("S26","Q-SP:$spath");}
  if(-e $tpath) {
    if(!(-d $tpath)) {&do_copy_query("S91","Q-SP:$spath\nQ-TP:$tpath");}
    if(!(-w $tpath)) {&do_copy_query("S27","Q-SP:$spath\nQ-TP:$tpath");}
    if(!(-x $tpath)) {&do_copy_query("S28","Q-SP:$spath\nQ-TP:$tpath");}
  }
}

sub copy_file {
  my ($relpath,$base,$target)=@_;
  my $spath=$base."/".$relpath;
  my $tpath=$target."/".$relpath;
  my $isproc=0;
  if(defined($procpath)) {
    $isproc=($spath eq $procpath);
    if(!$isproc) {return;}
  }
  if($isproc && (($action eq $ACTION_SKIP)||($policy eq $POLICY_NEVER))) {
    &reset_proceed();
    return;
  }
  &copy_file_check($spath,$tpath);
  if(-f $tpath) {
    if($isproc) {
      &reset_proceed();
    } else {
      &do_copy_query("S50","Q-SP:$spath\nQ-TP:$tpath") if((!defined($policy))||($policy eq $POLICY_ASK));
      return if($policy eq $POLICY_NEVER);
    }
  } elsif($isproc) {&reset_proceed();}
  my $res=copy($spath,$tpath);
  if($res==0) {
    &copy_file_check($spath,$tpath);
    &do_copy_query("S101","Q-SP:$spath\nQ-TP:$tpath");
  }
}

sub copy_file_check {
  my ($spath,$tpath)=@_;
  if(!(-r $spath)) {&do_copy_query("S23","Q-SP:$spath");}
  if(-e $tpath) {
    if(!(-f $tpath)) {&do_copy_query("S91","Q-SP:$spath\nQ-TP:$tpath");}
    if(!(-w $tpath)) {&do_copy_query("S24","Q-SP:$spath\nQ-TP:$tpath");}
  }
}

sub copy_symlink {
  my ($name,$parent,$target)=@_;
  my $path=$parent."/".$name;
  print "$path\n";
}


##########
# DELETE #
##########

sub do_delete {
  &error_response("E6","B") if(!defined $args{"B"});
  my $base=${$args{"B"}}[0];
  &failed_response("S20","F-B:$base") if(!(-d $base));
  $procpath=${$args{"P-SP"}}[0] if(defined $args{"P-SP"});
  $action=${$args{"P-AC"}}[0] if(defined $args{"P-AC"});
  &error_response("E6") if((defined($procpath) && !defined($action))||(defined($action) && !defined($procpath)));
  if(!defined $args{"S"}) {
    &delete_dir("",$base);
  } else {
    my $len=@{$args{"S"}};
    for(my $i=0;$i<$len;$i++) {
      my $name=${$args{"S"}}[$i];
      my $spath=$base."/".$name;
      my $isproc=0;
      $isproc=($spath eq $procpath) if(defined($procpath));
      if(!(-e $spath)) {
        &do_delete_query("S21","Q-SP:$spath") if(!$isproc);
      } elsif(-l $spath) {
        &delete_symlink($name,$base);
      } elsif(-d $spath) {
        &delete_dir($name,$base);
      } elsif(-f $spath) {
        &delete_file($name,$base);
      } else {
        &do_delete_query("S29","Q-SP:$spath") if(!$isproc);
      }
      undef(${$args{"S"}}[$i]);
    }
  }
  print "$version\n";
  print "Done\n";
  print "\n";
  exit 0;
}

sub delete_file {
  my ($relpath,$base)=@_;
  my $spath=$base."/".$relpath;
  my $isproc=0;
  if(defined($procpath)) {
    $isproc=($spath eq $procpath);
    if(!$isproc) {return;}
  }
  if($isproc && ($action eq $ACTION_SKIP)) {
    &reset_proceed();
    return;
  }
  my $res=unlink($spath);
  if($res==0) {
    &do_delete_query("S121","Q-SP:$spath");
  }
}

sub delete_dir {
  my ($relpath,$base)=@_;
  my $spath=$relpath;
  $spath=$base."/".$relpath if(!($base eq ""));
  my $isproc=0;
  if(defined($procpath)) {
    $isproc=($spath eq $procpath);
    if(!$isproc) {
      return if(length($spath)>length($procpath));
      return if(!($spath eq substr($procpath,0,length($spath))));
    }
  }
  if($isproc && ($action eq $ACTION_SKIP)) {
    &reset_proceed();
    return;
  }
  if(opendir(DH,$spath)) {
    my @contents=readdir(DH);
    closedir(DH);
    my $file;
    my @files=sort grep(!/^\.\.?$/,@contents);
    foreach $file (@files) {
      my $relfp=$relpath."/".$file;
      my $fp=$base."/".$relfp;
      if(-l $fp) {
        &delete_symlink($relfp,$base);
      } elsif(-d $fp) {
        &delete_dir($relfp,$base);
      } elsif(-f $fp) {
        &delete_file($relfp,$base);
      }
    }
  } else {
    &do_delete_query("S90","Q-SP:$spath");
  }
  my $res=rmdir($spath);
  if($res==0) {
    &do_delete_query("S122","Q-SP:$spath");
  }
}

sub delete_symlink {
  my ($relpath,$base)=@_;
  my $spath=$base."/".$relpath;
  my $isproc=0;
  if(defined($procpath)) {
    $isproc=($spath eq $procpath);
    if(!$isproc) {return;}
  }
  if($isproc && ($action eq $ACTION_SKIP)) {
    &reset_proceed();
    return;
  }
  my $res=unlink($spath);
  if($res==0) {
    &do_delete_query("S123","Q-SP:$spath");
  }
}

sub do_delete_query {
  my ($sc,$src)=@_;
  print "$version\n";
  print "Query\n";
  my $base=${$args{"B"}}[0];
  print "B:$base\n";
  my @sources=@{$args{"S"}};
  foreach(@sources) {
    if(defined($_)) {
      print "S:$_\n";
    }
  }
  print "Q-SC:$sc\n";
  print "$src\n";
  print "\n";
  exit 0;
}

########
# MOVE #
########

sub do_move {
  $action=${$args{"P-AC"}}[0] if(defined $args{"P-AC"});
  if(defined($action)) {
    &done_response() if($action eq $ACTION_ABORT);
    &error_response("E7",$action) if(!($action eq $ACTION_SKIP));
  }
  &error_response("E6","S") if(!defined $args{"S"});
  &error_response("E6","B") if(!defined $args{"B"});
  &error_response("E6","T") if(!defined $args{"T"});
  $procpath=${$args{"P-SP"}}[0] if(defined $args{"P-SP"});
  &error_response("E6") if((defined($procpath) && !defined($action))||(defined($action) && !defined($procpath)));
  my $base=${$args{"B"}}[0];
  &failed_response("S20","F-B:$base") if(!(-d $base));
  my $target=${$args{"T"}}[0];
  &failed_response("S33","F-TP:$target") if(!(-d $target));
  &failed_response("S31","F-TP:$target") if(!(-w $target));
  my $len=@{$args{"S"}};
  for(my $i=0;$i<$len;$i++) {
    my $name=${$args{"S"}}[$i];
    my $spath=$base."/".$name;
    my $isproc=0;
    $isproc=($spath eq $procpath) if(defined($procpath));
    if(!(-e $spath)) {
      &do_move_query("S21","Q-SP:$spath") if(!$isproc);
    } elsif(-l $spath) {
      &move_symlink($name,$base,$target);
    } elsif(-d $spath) {
      &move_dir($name,$base,$target);
    } elsif(-f $spath) {
      &move_file($name,$base,$target);
    } else {
      &do_move_query("S29","Q-SP:$spath") if(!$isproc);
    }
    undef(${$args{"S"}}[$i]);
  }
  &done_response();
}

sub move_file {
  my ($relpath,$base,$target)=@_;
  my $spath=$base."/".$relpath;
  my $tpath=$target."/".$relpath;
  my $isproc=0;
  if(defined($procpath)) {
    &reset_proceed() if($spath eq $procpath);
    return;
  }
  &do_move_query("S35","Q-SP:$spath\nQ-TP:$tpath") if(-e $tpath);
  my $res=move($spath,$tpath);
  if($res==0) {
    &do_move_query("S141","Q-SP:$spath");
  }
}


sub move_dir {
  my ($relpath,$base,$target)=@_;
  my $spath=$base."/".$relpath;
  my $tpath=$target."/".$relpath;
  my $isproc=0;
  if(defined($procpath)) {
    &reset_proceed() if($spath eq $procpath);
    return;
  }
  &do_move_query("S35","Q-SP:$spath\nQ-TP:$tpath") if(-e $tpath);
  my $res=move($spath,$tpath);
  if($res==0) {
    &do_move_query("S142","Q-SP:$spath");
  }
}

sub move_symlink {
  my ($relpath,$base,$target)=@_;
  my $spath=$base."/".$relpath;
  my $tpath=$target."/".$relpath;
  my $isproc=0;
  if(defined($procpath)) {
    &reset_proceed() if($spath eq $procpath);
    return;
  }
  &do_move_query("S35","Q-SP:$spath\nQ-TP:$tpath") if(-e $tpath);
  my $res=move($spath,$tpath);
  if($res==0) {
    &do_move_query("S143","Q-SP:$spath");
  }
}

sub do_move_query {
  my ($sc,$src)=@_;
  print "$version\n";
  print "Query\n";
  my $base=${$args{"B"}}[0];
  print "B:$base\n";
  my @sources=@{$args{"S"}};
  foreach(@sources) {
    if(defined($_)) {
      print "S:$_\n";
    }
  }
  my $target=${$args{"T"}}[0];
  print "T:$target\n";
  print "Q-SC:$sc\n";
  print "$src\n";
  print "\n";
  exit 0;
}

#######
# ZIP #
#######

sub do_zip {
  $action=${$args{"P-AC"}}[0] if(defined $args{"P-AC"});
  if(defined($action)) {
    &done_response() if($action eq $ACTION_ABORT);
    &error_response("E7",$action) if(!($action eq $ACTION_SKIP));
  }
  &error_response("E6","B") if(!defined $args{"B"});
  &error_response("E6","A") if(!defined $args{"A"});
  &error_response("E6","S") if(!defined $args{"S"});
  $procpath=${$args{"P-SP"}}[0] if(defined $args{"P-SP"});
  &error_response("E6") if((defined($procpath) && !defined($action))||(defined($action) && !defined($procpath)));
  my $base=${$args{"B"}}[0];
  &failed_response("S20","F-B:$base") if(!(-d $base));
  &failed_response("S93","F-B:$base") if(!chdir($base));
  my $archive=${$args{"A"}}[0];

  my $zip;
  if(-e $archive) {
    &failed_response("S160","F-A:$archive") unless unlink($archive)==1;
  }
  $zip=Archive::Zip->new();
  &failed_response("S160","F-A:$archive") unless $zip->writeToFileNamed($archive)==0;
  $zip=Archive::Zip->new($archive);

  my $len=@{$args{"S"}};
  for(my $i=0;$i<$len;$i++) {
    my $name=${$args{"S"}}[$i];
    my $spath=$base."/".$name;
    if($procpath && ($spath eq $procpath)) {
      undef(${$args{"S"}}[$i]);
      &reset_proceed();
      next();
    }
    if(!(-e $name)) {
      &do_zip_query("S21","Q-SP:$spath");
    } elsif(-d $name) {
      &zip_dir($name,$base,$zip);
    } elsif(-f $name) {
      &zip_file($name,$base,$zip);
    } else {
      &do_zip_query("S29","Q-SP:$spath");
    }
    undef(${$args{"S"}}[$i]);
  }
  &done_response();
}

sub zip_file {
  my ($relpath,$base,$zip)=@_;
  my $spath=$base."/".$relpath;
  if($procpath) {
    &reset_proceed() if($spath eq $procpath);
    return;
  }
  &do_zip_query("S52","Q-SP:$spath") if(!(-r $relpath));
  $zip->addFile($relpath);
  if($zip) {
    &do_zip_query("S161","Q-SP:$spath") unless $zip->overwrite()==0;
  }
}

sub zip_dir {
  my ($relpath,$base,$zip)=@_;
  my $spath=$base."/".$relpath;
  if($procpath) {
    &reset_proceed() if($spath eq $procpath);
    return;
  }
  &do_zip_query("S62","Q-SP:$spath") if(!(-r $relpath));
  &do_zip_query("S63","Q-SP:$spath") if(!(-x $relpath));
  $zip->addTree($relpath,$relpath);
  if($zip) {
    &do_zip_query("S162","Q-SP:$spath") unless $zip->overwrite()==0;
  }
}

sub do_zip_query {
  my ($sc,$src)=@_;
  print "$version\n";
  print "Query\n";
  my $base=${$args{"B"}}[0];
  print "B:$base\n";
  my @sources=@{$args{"S"}};
  foreach(@sources) {
    if(defined($_)) {
      print "S:$_\n";
    }
  }
  my $archive=${$args{"A"}}[0];
  print "A:$archive\n";
  print "Q-SC:$sc\n";
  print "$src\n";
  print "\n";
  exit 0;
}

#########
# CHMOD #
#########

sub do_chmod {
  $action=${$args{"P-AC"}}[0] if(defined $args{"P-AC"});
  if(defined($action)) {
    &done_response() if($action eq $ACTION_ABORT);
    &error_response("E7",$action) if(!($action eq $ACTION_SKIP));
  }
  &error_response("E6","B") if(!defined $args{"B"});
  &error_response("E6","S") if(!defined $args{"S"});
  &error_response("E6","C") if(!defined $args{"C"});
  $procpath=${$args{"P-SP"}}[0] if(defined $args{"P-SP"});
  &error_response("E6") if((defined($procpath) && !defined($action))||(defined($action) && !defined($procpath)));
  my $base=${$args{"B"}}[0];
  &failed_response("S20","F-B:$base") if(!(-d $base));
  my $chmods=${args{"C"}}[0];
  my $len=@{$args{"S"}};
  for(my $i=0;$i<$len;$i++) {
    my $name=${$args{"S"}}[$i];
    my $spath=$base."/".$name;
    my $isproc=0;
    $isproc=($spath eq $procpath) if(defined($procpath));
    if($isproc) {
      undef(${$args{"S"}}[$i]);
      next();
    }
    if(!(-e $spath)) {
      &do_chmod_query("S21","Q-SP:$spath");
    } elsif((-l $spath)||(-d $spath)||(-f $spath)) {
      my $mods=(stat($spath))[2] & 0x1FF;
      $mods=&getmod($mods,$chmods);
      my $res=chmod($mods,$spath);
      if($res!=1) {
        &do_chmod_query("S200","Q-SP:$spath");
      }
    } else {
      &do_chmod_query("S29","Q-SP:$spath");
    }
    undef(${$args{"S"}}[$i]);
  }
  &done_response();
}

sub getmod {
  my($acc,$modStr)=@_;
  my $accStr=&dec2bin($acc);
  my $accUpd="";
  for(my $i=0;$i<length($modStr);$i++) {
    my $num=substr($modStr,$i,1);
    if($num eq "2") {
      $accUpd=$accUpd.substr($accStr,$i,1);
    } else {
      $accUpd=$accUpd.$num;
    }
  }
  return &bin2dec($accUpd);
}

sub dec2bin {
    my $str = unpack("B32", pack("n", shift));
    $str =~ s/^0{7}(?=\d)//;
    return $str;
}

sub bin2dec {
    return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}

sub do_chmod_query {
  my ($sc,$src)=@_;
  print "$version\n";
  print "Query\n";
  my $base=${$args{"B"}}[0];
  print "B:$base\n";
  my @sources=@{$args{"S"}};
  foreach(@sources) {
    if(defined($_)) {
      print "S:$_\n";
    }
  }
  my $chmods=${$args{"C"}}[0];
  print "C:$chmods\n";
  print "Q-SC:$sc\n";
  print "$src\n";
  print "\n";
  exit 0;
}


#########
# UNZIP #
#########

sub do_unzip {
  &error_response("E6","A") if(!defined $args{"A"});
  my $archive=${$args{"A"}}[0];
  &error_response("E6","T") if(!defined $args{"T"});
  my $target=${$args{"T"}}[0];
  &failed_response("S184","F-S:$archive") if(!(-f $archive));
  &failed_response("S185","F-S:$archive") if(!(-r $archive));
  $policy=${args{"OP"}}[0] if(defined $args{"OP"});
  $procpath=${$args{"P-SP"}}[0] if(defined $args{"P-SP"});
  $action=${$args{"P-AC"}}[0] if(defined $args{"P-AC"});
  &error_response("E6") if((defined($procpath) && !defined($action))||(defined($action) && !defined($procpath)));
  if($procpath) {
    if($action eq $ACTION_ALWAYS) {$policy=$POLICY_ALWAYS;}
    elsif($action eq $ACTION_NEVER) {$policy=$POLICY_NEVER;}
  }
  my $zip=Archive::Zip->new($archive);
  my @members=$zip->members();
  foreach(@members) {
    my $tpath=$target."/".$_->fileName();
    if(!$_->isDirectory()) {
      &unzip_file($zip,$_,$target);
    } else {
      $zip->extractMember($_,$target."/".$_->fileName());
    }
  }
  &done_response();
}

sub unzip_file {
  my ($zip,$member,$target)=@_;
  my $spath=$member->fileName();
  my $tpath=$target."/".$spath;
  my $isproc=0;
  if(defined($procpath)) {
    $isproc=($spath eq $procpath);
    if(!$isproc) {return;}
  }
  if($isproc && (($action eq $ACTION_SKIP)||($policy eq $POLICY_NEVER))) {
    &reset_proceed();
    return;
  }
  if(-e $tpath) {
    if(!(-f $tpath)) {&do_unzip_query("S91","Q-SP:$spath\nQ-TP:$tpath");}
    if(!(-w $tpath)) {&do_unzip_query("S24","Q-SP:$spath\nQ-TP:$tpath");}
  }
  if(-f $tpath) {
    if($isproc) {
      &reset_proceed();
    } else {
      &do_unzip_query("S50","Q-SP:$spath\nQ-TP:$tpath") if((!defined($policy))||($policy eq $POLICY_ASK));
      return if($policy eq $POLICY_NEVER);
    }
  } elsif($isproc) {&reset_proceed();}
  my $res=$zip->extractMember($member,$tpath);
  &do_unzip_query("S101","Q-SP:$spath\nQ-TP:$tpath") unless $res==0;
}

sub do_unzip_query {
  my ($sc,$src)=@_;
  print "$version\n";
  print "Query\n";
  print "Q-SC:$sc\n";
  print "$src\n";
  print "\n";
  exit 0;
}


########
# TEST #
########

sub do_test {
  &error_response("E6","TP") if(!defined $args{"TP"});
  &error_response("E6","TF") if(!defined $args{"TF"});
  my $tp=${$args{"TP"}}[0];
  my $tf=${$args{"TF"}}[0];
  my $len=length($tf);
  my $fl="";
  for(my $i=0;$i<$len;$i++) {
    my $tf=substr($tf,$i,1);
    if($tf eq "e") {$fl.="e" if -e $tp;}
    elsif($tf eq "f") {$fl.="f" if -f $tp;}
    elsif($tf eq "d") {$fl.="d" if -d $tp;}
    elsif($tf eq "r") {$fl.="r" if -r $tp;}
    elsif($tf eq "w") {$fl.="w" if -w $tp;}
    elsif($tf eq "x") {$fl.="x" if -x $tp;}
  }
  print "$version\n";
  print "Done\n";
  print "D-SF:$fl\n" if(length($fl)>0);
  print "\n";
  exit 0;
}


########
# STAT #
########

sub do_stat() {
  &error_response("E6","P") if(!defined $args{"P"});
  my $path=${$args{"P"}}[0];
  print "$version\n";
  print "Done\n";
  &do_stat_sub(&get_name($path),&get_parent($path));
  print "\n";
  exit 0;
}

sub do_stat_sub() {
  my ($file,$base,$islink)=@_;
  my @info=lstat($base."/".$file);
  my $type="U";
  my $argname="D-F";
  $argname="D-L" if($islink);
  if(-f _) {$type="F";} elsif(-d _) {$type="D";} elsif(-l _) {$type="L";} elsif(-S _) {$type="S";}
  elsif(-p _) {$type="P";} elsif(-b _) {$type="B";} elsif(-c _) {$type="C";}
  printf "$argname:%1s %04o %u %u %s\n",$type,$info[2] & 07777,$info[7],$info[9],$file;
  if($type eq "L") {
    my $link=readlink($base."/".$file);
    if(substr($link,0,1) eq "/") {&do_stat_sub($link,"",1);}
    else {&do_stat_sub($link,$base,1);}
  }
}

########
# LIST #
########

sub do_list() {
  my ($dir)=@_;
  if(opendir(DH,$dir)) {
    my @contents=readdir(DH);
    closedir(DH);
    my $file;
    my @files=sort grep(!/^\.\.?$/,@contents);
    foreach $file (@files) {
      &do_stat($file,$dir);
    }
  }
}



#HELPER ROUTINES

sub quote_name {
  my($name)=@_;
  $name=~ s/(\W)/\\$1/g;
  return $name;
}

sub get_parent {
  my($path)=@_;
  my $ind=rindex($path,"/");
  return $ind<1 ? "." : substr($path,0,$ind);
}

sub get_name {
  my($path)=@_;
  my $ind=rindex($path,"/");
  return $ind==-1 ? $path : substr($path,$ind+1);
}

sub is_parent {
  my($path,$ppath)=@_;
  if(length($path)>length($ppath)) {
    return 1 if(($ppath eq substr($path,0,length($ppath)))&&(substr($path,length($ppath),1) eq "/"));
  }
  return 0;
}